├── .gitignore ├── Demos ├── Files │ ├── 01-base.graphql │ ├── 02-hero.graphql │ ├── 03-alias.graphql │ ├── 04-rolldice.graphql │ ├── 05-multi.graphql │ ├── 06-complex.graphql │ ├── 07-class.graphql │ ├── 08-simple-variable.graphql │ ├── 09-dbquery-simple.graphql │ ├── 10-dbquery-variable.graphql │ └── 11-dbquery-array.graphql ├── GraphQL.Demos.Build.101.bat ├── GraphQL.Demos.Build.102.bat ├── GraphQL.Demos.Build.103.bat ├── GraphQL.Demos.Build.104.bat ├── GraphQL.Demos.Build.110.bat ├── GraphQL.Demos.Build.Common.bat ├── GraphQLDemos.groupproj ├── Main │ ├── Demo.Form.Main.dfm │ ├── Demo.Form.Main.pas │ ├── MainDemo.dpr │ ├── MainDemo.dproj │ └── MainDemo.res ├── PascalQuery │ ├── Demo.API.Test.pas │ ├── Demo.Form.Parameters.dfm │ ├── Demo.Form.Parameters.pas │ ├── Demo.Form.RttiQuery.dfm │ ├── Demo.Form.RttiQuery.pas │ ├── RttiQuery.dpr │ ├── RttiQuery.dproj │ └── RttiQuery.res └── Proxy │ ├── Demo.Form.Parameters.dfm │ ├── Demo.Form.Parameters.pas │ ├── Demo.Form.ProxyClient.dfm │ ├── Demo.Form.ProxyClient.pas │ ├── Demo.ProxyServer.pas │ ├── ProxyDemo.dpr │ ├── ProxyDemo.dproj │ └── ProxyDemo.res ├── LICENSE ├── README.md ├── Source ├── GraphQL.Classes.pas ├── GraphQL.Core.Attributes.pas ├── GraphQL.Core.pas ├── GraphQL.Lexer.Core.pas ├── GraphQL.Query.pas ├── GraphQL.Resolver.Core.pas ├── GraphQL.Resolver.ReST.pas ├── GraphQL.Resolver.Rtti.pas ├── GraphQL.SyntaxAnalysis.Builder.pas ├── GraphQL.SyntaxAnalysis.Core.pas ├── GraphQL.Utils.JSON.pas └── GraphQL.Utils.Rtti.pas └── notes.txt /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | # C++ object files produced when C/C++ Output file generation is configured. 25 | # Uncomment this if you are not using external objects (zlib library for example). 26 | #*.obj 27 | # 28 | 29 | # Delphi compiler-generated binaries (safe to delete) 30 | *.exe 31 | *.dll 32 | *.bpl 33 | *.bpi 34 | *.dcp 35 | *.so 36 | *.apk 37 | *.drc 38 | *.map 39 | *.dres 40 | *.rsm 41 | *.tds 42 | *.dcu 43 | *.lib 44 | *.a 45 | *.o 46 | *.ocx 47 | 48 | # Delphi autogenerated files (duplicated info) 49 | *.cfg 50 | *.hpp 51 | *Resource.rc 52 | 53 | # Delphi local files (user-specific info) 54 | *.local 55 | *.identcache 56 | *.projdata 57 | *.tvsconfig 58 | *.dsk 59 | 60 | # Delphi history and backups 61 | __history/ 62 | __recovery/ 63 | *.~* 64 | 65 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 66 | *.stat 67 | -------------------------------------------------------------------------------- /Demos/Files/01-base.graphql: -------------------------------------------------------------------------------- 1 | { 2 | hero(id: "1000") { 3 | name 4 | height 5 | } 6 | } 7 | -------------------------------------------------------------------------------- /Demos/Files/02-hero.graphql: -------------------------------------------------------------------------------- 1 | { 2 | hero { 3 | name 4 | # Queries can have comments! 5 | friends { 6 | name 7 | } 8 | } 9 | } -------------------------------------------------------------------------------- /Demos/Files/03-alias.graphql: -------------------------------------------------------------------------------- 1 | { 2 | empireHero: hero(id: "1004") { 3 | name 4 | }, 5 | jediHero: hero(id: "1000") { 6 | name 7 | } 8 | } -------------------------------------------------------------------------------- /Demos/Files/04-rolldice.graphql: -------------------------------------------------------------------------------- 1 | { 2 | rollDice(numDice: 3, numSides: 6) 3 | } -------------------------------------------------------------------------------- /Demos/Files/05-multi.graphql: -------------------------------------------------------------------------------- 1 | { 2 | roll6: rollDice(numDice: 3, numSides: 6) 3 | roll20: rollDice(numDice: 3, numSides: 12) 4 | } 5 | -------------------------------------------------------------------------------- /Demos/Files/06-complex.graphql: -------------------------------------------------------------------------------- 1 | { 2 | roll6: rollDice(numDice: 3, numSides: 6) 3 | roll20: rollDice(numDice: 3, numSides: 12) 4 | reverseString(value: "ciao") 5 | hero(id: "1000") { 6 | name 7 | height 8 | friends { 9 | name 10 | } 11 | } 12 | } 13 | -------------------------------------------------------------------------------- /Demos/Files/07-class.graphql: -------------------------------------------------------------------------------- 1 | { 2 | counter 3 | Sum(a:1,b:2) 4 | mainHero { 5 | name 6 | height 7 | } 8 | } 9 | -------------------------------------------------------------------------------- /Demos/Files/08-simple-variable.graphql: -------------------------------------------------------------------------------- 1 | query HeroNameAndFriends($episode: String = "NEWHOPE") { 2 | hero(episode: $episode) { 3 | name 4 | friends { 5 | name 6 | } 7 | } 8 | } -------------------------------------------------------------------------------- /Demos/Files/09-dbquery-simple.graphql: -------------------------------------------------------------------------------- 1 | query { 2 | authors(where: { id: { _eq: 3 } }) { 3 | id 4 | name 5 | } 6 | } -------------------------------------------------------------------------------- /Demos/Files/10-dbquery-variable.graphql: -------------------------------------------------------------------------------- 1 | query testById($id: Int = 1) { 2 | authors(where: { id: { _eq: $id } }) { 3 | id 4 | name 5 | } 6 | } -------------------------------------------------------------------------------- /Demos/Files/11-dbquery-array.graphql: -------------------------------------------------------------------------------- 1 | query { 2 | articles( 3 | where: { 4 | _and: [ 5 | { rating: { _gte: 5 } }, 6 | { rating: { _lte: 15 } } 7 | ] 8 | } 9 | ) { 10 | id 11 | title 12 | rating 13 | } 14 | } -------------------------------------------------------------------------------- /Demos/GraphQL.Demos.Build.101.bat: -------------------------------------------------------------------------------- 1 | @ECHO OFF 2 | 3 | :: Delphi 10.1 Berlin 4 | @SET "BDS=C:\Program Files (x86)\Embarcadero\Studio\18.0" 5 | 6 | call "%BDS%\bin\rsvars.bat" 7 | call GraphQL.Demos.Build.Common.bat 8 | 9 | pause>nul -------------------------------------------------------------------------------- /Demos/GraphQL.Demos.Build.102.bat: -------------------------------------------------------------------------------- 1 | @ECHO OFF 2 | 3 | :: Delphi 10.2 Tokyo 4 | @SET "BDS=C:\Program Files (x86)\Embarcadero\Studio\19.0" 5 | 6 | call "%BDS%\bin\rsvars.bat" 7 | call GraphQL.Demos.Build.Common.bat 8 | 9 | pause>nul -------------------------------------------------------------------------------- /Demos/GraphQL.Demos.Build.103.bat: -------------------------------------------------------------------------------- 1 | @ECHO OFF 2 | 3 | :: Delphi 10.3 Rio 4 | @SET "BDS=C:\Program Files (x86)\Embarcadero\Studio\20.0" 5 | 6 | call "%BDS%\bin\rsvars.bat" 7 | call GraphQL.Demos.Build.Common.bat 8 | 9 | pause>nul -------------------------------------------------------------------------------- /Demos/GraphQL.Demos.Build.104.bat: -------------------------------------------------------------------------------- 1 | @ECHO OFF 2 | 3 | :: Delphi 10.4 Sydney 4 | @SET "BDS=C:\Program Files (x86)\Embarcadero\Studio\21.0" 5 | 6 | call "%BDS%\bin\rsvars.bat" 7 | call GraphQL.Demos.Build.Common.bat 8 | 9 | pause>nul -------------------------------------------------------------------------------- /Demos/GraphQL.Demos.Build.110.bat: -------------------------------------------------------------------------------- 1 | @ECHO OFF 2 | 3 | :: Delphi 11 Alexandria 4 | @SET "BDS=C:\Program Files (x86)\Embarcadero\Studio\22.0" 5 | 6 | call "%BDS%\bin\rsvars.bat" 7 | call GraphQL.Demos.Build.Common.bat 8 | 9 | pause>nul -------------------------------------------------------------------------------- /Demos/GraphQL.Demos.Build.Common.bat: -------------------------------------------------------------------------------- 1 | SET _TARGET=%1 2 | IF [%1] == [] (SET _TARGET="Make") 3 | 4 | SET _CONFIG=%2 5 | IF [%2] == [] (SET _CONFIG="Debug") 6 | 7 | SET _PLATFORM=%3 8 | IF [%3] == [] (SET _PLATFORM="Win32") 9 | 10 | SET BUILDTARGET="/t:%_TARGET%" 11 | SET BUILDCONFIG="/p:config=%_CONFIG%" 12 | SET BUILDPLATFORM="/p:platform=%_PLATFORM%" 13 | 14 | SET "ERRORCOUNT=0" 15 | 16 | @ECHO OFF 17 | 18 | msbuild Main\MainDemo.dproj %BUILDTARGET% %BUILDCONFIG% %BUILDPLATFORM% 19 | IF %ERRORLEVEL% NEQ 0 set /a ERRORCOUNT+=1 20 | msbuild PascalQuery\RttiQuery.dproj %BUILDTARGET% %BUILDCONFIG% %BUILDPLATFORM% 21 | IF %ERRORLEVEL% NEQ 0 set /a ERRORCOUNT+=1 22 | msbuild Proxy\ProxyDemo.dproj %BUILDTARGET% %BUILDCONFIG% %BUILDPLATFORM% 23 | IF %ERRORLEVEL% NEQ 0 set /a ERRORCOUNT+=1 24 | 25 | 26 | IF %ERRORCOUNT% NEQ 0 ( 27 | 28 | ECHO =========================================== 29 | ECHO === %ERRORCOUNT% GraphQL Demos Failed to Compile === 30 | ECHO =========================================== 31 | EXIT /B 1 32 | 33 | ) ELSE ( 34 | 35 | ECHO =========================================== 36 | ECHO === GraphQL Demos Compiled Successful === 37 | ECHO =========================================== 38 | 39 | ) 40 | 41 | -------------------------------------------------------------------------------- /Demos/GraphQLDemos.groupproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {7B8A8CED-560E-44E6-AC74-765E5D6DA51A} 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | Default.Personality.12 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | -------------------------------------------------------------------------------- /Demos/Main/Demo.Form.Main.dfm: -------------------------------------------------------------------------------- 1 | object MainForm: TMainForm 2 | Left = 0 3 | Top = 0 4 | Caption = 'Syntax analysis Demo' 5 | ClientHeight = 588 6 | ClientWidth = 911 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -13 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | KeyPreview = True 14 | OldCreateOrder = True 15 | OnCreate = FormCreate 16 | OnKeyUp = FormKeyUp 17 | DesignSize = ( 18 | 911 19 | 588) 20 | PixelsPerInch = 96 21 | TextHeight = 16 22 | object Label1: TLabel 23 | Left = 8 24 | Top = 64 25 | Width = 74 26 | Height = 16 27 | Caption = 'Choose a file' 28 | end 29 | object SourceMemo: TMemo 30 | Left = 8 31 | Top = 88 32 | Width = 433 33 | Height = 261 34 | Anchors = [akLeft, akTop, akBottom] 35 | Font.Charset = DEFAULT_CHARSET 36 | Font.Color = clWindowText 37 | Font.Height = -16 38 | Font.Name = 'Consolas' 39 | Font.Style = [] 40 | ParentFont = False 41 | TabOrder = 0 42 | end 43 | object LogMemo: TMemo 44 | Left = 8 45 | Top = 395 46 | Width = 893 47 | Height = 185 48 | Anchors = [akLeft, akRight, akBottom] 49 | Font.Charset = DEFAULT_CHARSET 50 | Font.Color = clWindowText 51 | Font.Height = -15 52 | Font.Name = 'Consolas' 53 | Font.Style = [] 54 | Lines.Strings = ( 55 | '...') 56 | ParentFont = False 57 | ReadOnly = True 58 | ScrollBars = ssBoth 59 | TabOrder = 1 60 | WordWrap = False 61 | end 62 | object TreeBuilderButton: TButton 63 | Left = 8 64 | Top = 355 65 | Width = 150 66 | Height = 34 67 | Anchors = [akLeft, akBottom] 68 | Caption = 'Build syntax tree (F5)' 69 | TabOrder = 2 70 | OnClick = TreeBuilderButtonClick 71 | end 72 | object SyntaxTreeView: TTreeView 73 | Left = 458 74 | Top = 88 75 | Width = 445 76 | Height = 261 77 | Anchors = [akLeft, akTop, akRight, akBottom] 78 | Indent = 19 79 | ReadOnly = True 80 | TabOrder = 3 81 | end 82 | object FilesComboBox: TComboBox 83 | Left = 88 84 | Top = 59 85 | Width = 353 86 | Height = 24 87 | TabOrder = 4 88 | OnChange = FilesComboBoxChange 89 | end 90 | object Panel1: TPanel 91 | Left = 0 92 | Top = 0 93 | Width = 911 94 | Height = 52 95 | Align = alTop 96 | BevelOuter = bvNone 97 | Caption = 'Panel1' 98 | Color = clWhite 99 | ParentBackground = False 100 | ShowCaption = False 101 | TabOrder = 5 102 | object Label2: TLabel 103 | Left = 59 104 | Top = 3 105 | Width = 181 106 | Height = 25 107 | Caption = 'GraphQL for Delphi' 108 | Font.Charset = DEFAULT_CHARSET 109 | Font.Color = 9961697 110 | Font.Height = -21 111 | Font.Name = 'Tahoma' 112 | Font.Style = [] 113 | ParentFont = False 114 | end 115 | object Label3: TLabel 116 | Left = 59 117 | Top = 30 118 | Width = 101 119 | Height = 16 120 | Caption = 'Syntax analysis' 121 | Font.Charset = DEFAULT_CHARSET 122 | Font.Color = 9961697 123 | Font.Height = -13 124 | Font.Name = 'Tahoma' 125 | Font.Style = [fsBold] 126 | ParentFont = False 127 | end 128 | object Image1: TImage 129 | Left = 8 130 | Top = 3 131 | Width = 41 132 | Height = 46 133 | AutoSize = True 134 | Picture.Data = { 135 | 0954506E67496D61676589504E470D0A1A0A0000000D49484452000000290000 136 | 002E0806000000B565304E0000000970485973000006EB000006EB014C319E4A 137 | 0000001974455874536F667477617265007777772E696E6B73636170652E6F72 138 | 679BEE3C1A000006B54944415478DADD590D6C535514FEEE5BB72112220490BF 139 | AD05C31C8A3A05C41FB28009642AF1171188FF81B56340801005813004A26070 140 | 8BB0B51D0A0615C34F14A382208A1832515140E547846CDD40A698628802EDB6 141 | F7FCEE5E1FBC757DEDD676CC7892977B7B7FCEF9EEB9E79C7BEEAD401248C3C6 142 | 141FCECE12D026F3A7835F950694DBD1B558605C43A2FC453240FAE0799BC513 143 | 11BADEB1C3F564BB83AC82772435F88555BF0A6D643F147CD9AE207DF02EE386 144 | 3F1F45C4723B9C2FB433484F318B1951869470CB67B61BC89328CF6A80FA1EAB 145 | B74519F613CD6162260A7EBEA2207D28EB02280B599DC22F954C547AB3D27CA4 146 | A652846CAFE357C6618BEC9872B64D416A2852AAD1537AF1ABFC7AE8C23537D9 147 | F4667DAC06A1516BC228D9BE81C08EB29436D9819F9FDF4B99A82D1528AA4F3A 148 | 48E9C52C4A28FCE650D3C70262060151B87A4002AE87186683A0F66C546CF05B 149 | 098C4172703A1AFCF5B02DE5828C7074548332CB81FC6DAD02590DCF1072CF53 150 | A0A55178455F38B7B3D44EA134235C00F76F66065C9FEA5BEFD9C162145915D1 151 | 8B1719FC7C7017B14D9AC49E4C387325AF4AB847A440947005B79817CAFE131A 152 | 35EFC36ACA6FB85385080AA8DB681ADF3782D43B3D54BF28688A5EEC665F05AB 153 | 33ADB68AF3C6B2D8C4EF643A3A66F7C453FF18F36BF0DA552AAE3EC2C5D9F9F3 154 | 317AF8666B9351DFA4490F627D7853F34219173E55029CC6DFAF47D1B604B426 155 | 15625E6F38FF341A2BB1B68382C06156FB713BC667C2B5217C6235DCE3690ED2 156 | FB6B383F9BF3CF9BE65FC3F973A087AF742BE19CDF0892AB45B685356829D0EE 157 | EE0BD7D7CD6DD4339FE016934D05010E97DB198903F9EF6691CBCE050EB89684 158 | F79F46F9D020D46F60E91FE2880419602DCD6A2534FC9CFE701D34B7D5C0DD87 159 | 7643AF4547721E4690FBACE657C17D2B17F01DAB013AD6C0EBE0AC36F757A23C 160 | 4781BA3FCA4E0624C813ACF4B718A0729BAE356FB3AE1DEF3ADD91B437EC2898 161 | 8C1844275A4D8D4C428484E334D6740F22588B8871B65193C74535BC2FD24196 162 | 46EC06DEA7961E6DBAF2B23B1428D2A1FE56D190D50F85B5B1401E87BB07177B 163 | 8CD5CEE49A4B67D8D374119E2D2C1EB4003997865464AB41CF0DB49947C27A0F 164 | A4216D742F3C77C6689091808BDACBEAED34E8D90E3857C40268106D78B6D03D 165 | FA074688A18C10AA791136289F9962B0419B3976823084FB507E1F07AD97ABA5 166 | DEA79F4357EF8D181734CFA0B73E43706BE5160411183400D3032D0579081BD3 167 | 3AC1FF23ABD753CEB33CCBDF0AEFEF0CBF53D523CD392A6D021D6D6B68479BA8 168 | BDD13EA9C11E660D4AFA03A59D2E40F9451E81043A865AFCA4A5002FF3778FE1 169 | FC8F58FD9D76983540EAC244BFC1DBAD0E9A945B49DBBDE4272D0649012F7338 170 | E39AB693CE32AAB5004DBBB1958BBC977C5E219FB94903C9AC87139443ACDA58 171 | E6D8917F285E9095F066F3E895DBAED1AC06F178FD35292069F41F70E043D440 172 | 31B77956BC004D721A1365DADD16DADDC309836430BE87C1F87356FD0A6C0332 173 | 30C99F284879240A5C3C46BEDDE9447974A2ED71839457D56AF8E569701377C7 174 | 451BF2260AD020665D2E6A92B9280E9F81C81902675D5C20A9C5A95CED4A0E3A 175 | 9881AE839371873648CF867A31E7D40633044E73A06055AB41067191D98F224F 176 | 896EC9B89646221EAF4CCDB4AF58FD8B2752966C6B15C83A0417723B0AF97B13 177 | 278C4B3640934C998F8E25905266F5452D06C9B379840A7527EBF5D4E2406AB1 178 | AAAD40EA997F8ACCA8D2B9EDA3434EDA1CA47E267BEE67887957E849804F66D4 179 | AC2F6182B1A0AD001A44D98BB96BF389C34790CCE4351E8BCA44C6E3AD324F15 180 | FBE04DED066DA38C83E689045CA741CD6A4B2D1AC4BB8F83601892906A6E9759 181 | 58066A1F179733ECE6141E6CDB8AE8401F52DA0391FA087E5E8CA457C8A36B25 182 | EDF2421B62EC483953D1784F8F4827625E1FFE0314887A11D36F56C2CD251E68 183 | 2B04BC5FE7F0BE5410E595E2B0304E95287C225E691325D39556DEEB2D7792E0 184 | 0B438F03DE55427F7C32D32E7E7B11E571201E8AF2387003EBB9E6A1545E6906 185 | F2A75FD23273469ECD228FA1278D994905F3BC1D56CF2CAD79C73193D57B92F1 186 | CC5203CF68CABF8B6D011E26DB789EEF0F69B3E50298AC16477AC7312DB40BDB 187 | FA50E029F3135FACF7A4589494A7BF7A0457D890BE9CBFE5DB500ABF066A6453 188 | 0A3ACC56717EF2157BFA3353B8D153BB75E1A745883D6F9B9A748A849C2FA1E7 189 | E82A940EE4B5673D6D2CC75AFB82E1AB7EA2038547E295F3FF7FD8D741C6FA8B 190 | 04CB08724EBB8294AFB70AC42EAB7E999B32D6ED6E5790922EBFB235A375D4E2 191 | D389F24F0AC8D01FA0B44B2D9F0C1DF4F62AC6412F73C112F3C354BCF42F0DB7 192 | E82AFDD032BE0000000049454E44AE426082} 193 | end 194 | end 195 | end 196 | -------------------------------------------------------------------------------- /Demos/Main/Demo.Form.Main.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi GraphQL } 4 | { Copyright (c) 2022 Luca Minuti } 5 | { https://github.com/lminuti/graphql } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | unit Demo.Form.Main; 23 | 24 | interface 25 | 26 | uses 27 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, 28 | System.Classes, System.IOUtils, System.Types, Vcl.Graphics, 29 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, 30 | GraphQL.Core, GraphQL.Lexer.Core, GraphQL.SyntaxAnalysis.Builder, Vcl.ExtCtrls, 31 | Vcl.Imaging.pngimage; 32 | 33 | type 34 | TMainForm = class(TForm) 35 | SourceMemo: TMemo; 36 | LogMemo: TMemo; 37 | TreeBuilderButton: TButton; 38 | SyntaxTreeView: TTreeView; 39 | FilesComboBox: TComboBox; 40 | Label1: TLabel; 41 | Panel1: TPanel; 42 | Label2: TLabel; 43 | Label3: TLabel; 44 | Image1: TImage; 45 | procedure FormCreate(Sender: TObject); 46 | procedure TreeBuilderButtonClick(Sender: TObject); 47 | procedure FilesComboBoxChange(Sender: TObject); 48 | procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 49 | private 50 | FSampleDir: string; 51 | procedure HandleReadToken(ASender: TObject; AToken: TToken); 52 | procedure ShowGraphQL(AGraphQL: IGraphQL); 53 | procedure ReadFiles; 54 | public 55 | { Public declarations } 56 | end; 57 | 58 | var 59 | MainForm: TMainForm; 60 | 61 | implementation 62 | 63 | {$R *.dfm} 64 | 65 | procedure TMainForm.FormCreate(Sender: TObject); 66 | begin 67 | ReadFiles; 68 | end; 69 | 70 | procedure TMainForm.ReadFiles; 71 | var 72 | LFiles: TStringDynArray; 73 | LFileName: string; 74 | begin 75 | FSampleDir := ExtractFileDir( ParamStr(0)) + PathDelim + '..' + PathDelim + '..' + PathDelim + '..' + PathDelim + 'Files'; 76 | 77 | FilesComboBox.Items.Clear; 78 | LFiles := TDirectory.GetFiles(FSampleDir); 79 | for LFileName in LFiles do 80 | FilesComboBox.Items.Add(ExtractFileName(LFileName)); 81 | end; 82 | 83 | procedure TMainForm.TreeBuilderButtonClick(Sender: TObject); 84 | var 85 | LBuilder: TGraphQLBuilder; 86 | LGraphQL: IGraphQL; 87 | begin 88 | inherited; 89 | if SourceMemo.Text = '' then 90 | Exit; 91 | 92 | SyntaxTreeView.Items.Clear; 93 | LogMemo.Clear; 94 | 95 | LBuilder := TGraphQLBuilder.Create(SourceMemo.Text); 96 | try 97 | LBuilder.OnReadToken := HandleReadToken; 98 | LGraphQL := LBuilder.Build; 99 | finally 100 | LBuilder.Free; 101 | end; 102 | 103 | ShowGraphQL(LGraphQL); 104 | 105 | end; 106 | 107 | procedure TMainForm.FilesComboBoxChange(Sender: TObject); 108 | var 109 | LFileName: string; 110 | begin 111 | if FilesComboBox.Text <> '' then 112 | begin 113 | LFileName := FSampleDir + PathDelim + FilesComboBox.Text; 114 | if FileExists(LFileName) then 115 | SourceMemo.Lines.LoadFromFile(LFileName); 116 | end; 117 | end; 118 | 119 | procedure TMainForm.FormKeyUp(Sender: TObject; var Key: Word; Shift: 120 | TShiftState); 121 | begin 122 | if Key = VK_F5 then 123 | TreeBuilderButton.Click; 124 | end; 125 | 126 | procedure TMainForm.HandleReadToken(ASender: TObject; AToken: TToken); 127 | begin 128 | LogMemo.Lines.Add(AToken.ToString); 129 | end; 130 | 131 | procedure TMainForm.ShowGraphQL(AGraphQL: IGraphQL); 132 | 133 | function GetFieldNameCaption(AGraphQLField: IGraphQLField): string; 134 | begin 135 | if AGraphQLField.FieldName = AGraphQLField.FieldAlias then 136 | Result := AGraphQLField.FieldName 137 | else 138 | Result := Format('%s (%s)', [AGraphQLField.FieldName, AGraphQLField.FieldAlias]) 139 | end; 140 | 141 | procedure ShowArguments(LGraphQLField: IGraphQLField; AParentNode: TTreeNode); 142 | var 143 | LArgumentsNode: TTreeNode; 144 | LGraphQLArgument: IGraphQLArgument; 145 | LArgumentInfo: string; 146 | begin 147 | if LGraphQLField.ArgumentCount > 0 then 148 | begin 149 | LArgumentsNode := SyntaxTreeView.Items.AddChild(AParentNode, 'Arguments'); 150 | for LGraphQLArgument in LGraphQLField.Arguments do 151 | begin 152 | if TGraphQLArgumentAttribute.Variable in LGraphQLArgument.Attributes then 153 | LArgumentInfo := 'Variable' 154 | else 155 | LArgumentInfo := VariableTypeToStr(LGraphQLArgument.ArgumentType); 156 | SyntaxTreeView.Items.AddChild(LArgumentsNode, Format('%s : %s (%s)', [LGraphQLArgument.Name, LGraphQLArgument.Value.ToString, LArgumentInfo])); 157 | end; 158 | end; 159 | end; 160 | 161 | procedure ShowObject(AGraphQLObject: IGraphQLObject; AParentNode: TTreeNode); 162 | var 163 | LSubNode: TTreeNode; 164 | LGraphQLField: IGraphQLField; 165 | begin 166 | for LGraphQLField in AGraphQLObject.Fields do 167 | begin 168 | LSubNode := SyntaxTreeView.Items.AddChild(AParentNode, GetFieldNameCaption(LGraphQLField)); 169 | ShowArguments(LGraphQLField, LSubNode); 170 | if Supports(LGraphQLField.Value, IGraphQLObject) then 171 | begin 172 | ShowObject(LGraphQLField.Value as IGraphQLObject, LSubNode); 173 | end; 174 | end; 175 | end; 176 | 177 | var 178 | LRootNode, LSubNode: TTreeNode; 179 | LGraphQLField: IGraphQLField; 180 | LGraphQLParam: IGraphQLParam; 181 | LRequiredString: string; 182 | LDefaultValueString: string; 183 | begin 184 | LRootNode := SyntaxTreeView.Items.AddChildFirst(nil, AGraphQL.Name + ' (query)'); 185 | 186 | if AGraphQL.ParamCount > 0 then 187 | begin 188 | LSubNode := SyntaxTreeView.Items.AddChild(LRootNode, 'Parameters'); 189 | for LGraphQLParam in AGraphQL.Params do 190 | begin 191 | LRequiredString := ''; 192 | LDefaultValueString := ''; 193 | if LGraphQLParam.Required then 194 | LRequiredString := ' (required)'; 195 | if not LGraphQLParam.DefaultValue.IsEmpty then 196 | LDefaultValueString := ' (default: ' + LGraphQLParam.DefaultValue.ToString + ')'; 197 | 198 | // if LGraphQLParam.ParamType = TGraphQLVariableType.ObjectType then 199 | // ShowParamObject(LSubNode, LGraphQLParam.) 200 | // else 201 | SyntaxTreeView.Items.AddChild(LSubNode, LGraphQLParam.ParamName + ':' + VariableTypeToStr(LGraphQLParam.ParamType) + LRequiredString + LDefaultValueString); 202 | end; 203 | end; 204 | 205 | for LGraphQLField in AGraphQL.Fields do 206 | begin 207 | LSubNode := SyntaxTreeView.Items.AddChild(LRootNode, GetFieldNameCaption(LGraphQLField)); 208 | ShowArguments(LGraphQLField, LSubNode); 209 | if Supports(LGraphQLField.Value, IGraphQLObject) then 210 | begin 211 | ShowObject(LGraphQLField.Value as IGraphQLObject, LSubNode); 212 | end; 213 | 214 | end; 215 | 216 | LRootNode.Expand(True); 217 | 218 | end; 219 | 220 | end. 221 | -------------------------------------------------------------------------------- /Demos/Main/MainDemo.dpr: -------------------------------------------------------------------------------- 1 | program MainDemo; 2 | 3 | uses 4 | Vcl.Forms, 5 | Demo.Form.Main in 'Demo.Form.Main.pas' {MainForm}, 6 | GraphQL.Classes in '..\..\Source\GraphQL.Classes.pas', 7 | GraphQL.Core in '..\..\Source\GraphQL.Core.pas', 8 | GraphQL.Lexer.Core in '..\..\Source\GraphQL.Lexer.Core.pas', 9 | GraphQL.SyntaxAnalysis.Builder in '..\..\Source\GraphQL.SyntaxAnalysis.Builder.pas', 10 | GraphQL.SyntaxAnalysis.Core in '..\..\Source\GraphQL.SyntaxAnalysis.Core.pas'; 11 | 12 | {$R *.res} 13 | 14 | begin 15 | ReportMemoryLeaksOnShutdown := True; 16 | Application.Initialize; 17 | Application.MainFormOnTaskbar := True; 18 | Application.CreateForm(TMainForm, MainForm); 19 | Application.Run; 20 | end. 21 | -------------------------------------------------------------------------------- /Demos/Main/MainDemo.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lminuti/graphql/4eeb388880f8abfd5faccc92a1783191de077a7a/Demos/Main/MainDemo.res -------------------------------------------------------------------------------- /Demos/PascalQuery/Demo.API.Test.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi GraphQL } 4 | { Copyright (c) 2022 Luca Minuti } 5 | { https://github.com/lminuti/graphql } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | unit Demo.API.Test; 23 | 24 | interface 25 | 26 | uses 27 | System.Classes, System.SysUtils, System.StrUtils, GraphQL.Core.Attributes; 28 | 29 | type 30 | TStarWarsHero = class; 31 | 32 | TStarWarsHeros = TArray; 33 | 34 | TStarWarsHero = class(TObject) 35 | private 36 | FName: string; 37 | FHeight: Double; 38 | FFriends: TStarWarsHeros; 39 | public 40 | property Name: string read FName write FName; 41 | property Height: Double read FHeight write FHeight; 42 | property Friends: TStarWarsHeros read FFriends; 43 | 44 | procedure AddFriend(AHero: TStarWarsHero); 45 | 46 | constructor Create(const AName: string; AHeight: Double); 47 | destructor Destroy; override; 48 | end; 49 | 50 | TTestApi = class(TObject) 51 | private 52 | FCounter: Integer; 53 | public 54 | [GraphQLEntity] 55 | function Sum(a, b: Integer): Integer; 56 | 57 | [GraphQLEntity('counter')] 58 | function Counter: Integer; 59 | 60 | [GraphQLEntity('mainHero')] 61 | function MainHero: TStarWarsHero; 62 | 63 | function Help: string; 64 | 65 | constructor Create; 66 | end; 67 | 68 | function RollDice(NumDices, NumSides: Integer): Integer; 69 | 70 | function ReverseString(const Value: string): string; 71 | 72 | function StarWarsHero(const Id: string): TStarWarsHero; 73 | function StarWarsHeroByEpisode(const Episode: string): TStarWarsHeros; 74 | 75 | implementation 76 | 77 | function RollDice(NumDices, NumSides: Integer): Integer; 78 | var 79 | I: Integer; 80 | begin 81 | Result := 0; 82 | for I := 0 to NumDices - 1 do 83 | Result := Result + (Random(NumSides) + 1); 84 | end; 85 | 86 | function ReverseString(const Value: string): string; 87 | begin 88 | Result := System.StrUtils.ReverseString(Value); 89 | end; 90 | 91 | function StarWarsHero(const Id: string): TStarWarsHero; 92 | begin 93 | if Id = '1000' then 94 | begin 95 | Result := TStarWarsHero.Create('Luke Skywalker', 1.72); 96 | Result.AddFriend(TStarWarsHero.Create('Han Solo', 1.8)); 97 | Result.AddFriend(TStarWarsHero.Create('R2-D2', 1.08)); 98 | end 99 | else if Id = '1001' then 100 | Result := TStarWarsHero.Create('Han Solo', 1.8) 101 | else if Id = '1002' then 102 | Result := TStarWarsHero.Create('Leia Organa', 1.55) 103 | else if Id = '1003' then 104 | Result := TStarWarsHero.Create('R2-D2', 1.08) 105 | else if Id = '1004' then 106 | Result := TStarWarsHero.Create('Darth Sidious', 1.73) 107 | else 108 | raise Exception.CreateFmt('Hero [%s] not found', [Id]); 109 | end; 110 | 111 | function StarWarsHeroByEpisode(const Episode: string): TStarWarsHeros; 112 | begin 113 | Result := []; 114 | if Episode = 'NEWHOPE' then 115 | begin 116 | Result := Result + [TStarWarsHero.Create('Luke Skywalker', 1.72)]; 117 | Result := Result + [TStarWarsHero.Create('Han Solo', 1.8)]; 118 | Result := Result + [TStarWarsHero.Create('Leia Organa', 1.55)]; 119 | end 120 | else if Episode = 'EMPIRE' then 121 | begin 122 | Result := Result + [TStarWarsHero.Create('Han Solo', 1.8)]; 123 | end 124 | else if Episode = 'JEDI' then 125 | begin 126 | Result := Result + [TStarWarsHero.Create('Leia Organa', 1.55)]; 127 | end 128 | else 129 | raise Exception.CreateFmt('Episode [%s] not found', [Episode]); 130 | end; 131 | 132 | { TStarWarsHero } 133 | 134 | procedure TStarWarsHero.AddFriend(AHero: TStarWarsHero); 135 | var 136 | LIndex: Integer; 137 | begin 138 | LIndex := Length(FFriends); 139 | SetLength(FFriends, LIndex + 1); 140 | FFriends[LIndex] := AHero; 141 | end; 142 | 143 | constructor TStarWarsHero.Create(const AName: string; AHeight: Double); 144 | begin 145 | inherited Create; 146 | 147 | // FFriends := TStarWarsHeros.Create; 148 | FName := AName; 149 | FHeight := AHeight; 150 | end; 151 | 152 | destructor TStarWarsHero.Destroy; 153 | var 154 | LHero: TStarWarsHero; 155 | begin 156 | for LHero in FFriends do 157 | LHero.Free; 158 | inherited; 159 | end; 160 | 161 | { TTestApi } 162 | 163 | function TTestApi.Counter: Integer; 164 | begin 165 | Inc(FCounter); 166 | Result := FCounter; 167 | end; 168 | 169 | constructor TTestApi.Create; 170 | begin 171 | FCounter := 0; 172 | end; 173 | 174 | function TTestApi.Help: string; 175 | begin 176 | Result := 'This function is called by a custom resolver' 177 | end; 178 | 179 | function TTestApi.MainHero: TStarWarsHero; 180 | begin 181 | Result := TStarWarsHero.Create('Luke Skywalker', 1.72);; 182 | end; 183 | 184 | function TTestApi.Sum(a, b: Integer): Integer; 185 | begin 186 | Result := a + b; 187 | end; 188 | 189 | end. 190 | -------------------------------------------------------------------------------- /Demos/PascalQuery/Demo.Form.Parameters.dfm: -------------------------------------------------------------------------------- 1 | object ParametersForm: TParametersForm 2 | Left = 0 3 | Top = 0 4 | BorderStyle = bsDialog 5 | Caption = 'Parameters' 6 | ClientHeight = 354 7 | ClientWidth = 423 8 | Color = clBtnFace 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'Tahoma' 13 | Font.Style = [] 14 | OldCreateOrder = False 15 | Position = poScreenCenter 16 | OnShow = FormShow 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | object ParamsGrid: TStringGrid 20 | Left = 0 21 | Top = 0 22 | Width = 423 23 | Height = 317 24 | Align = alClient 25 | Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing] 26 | TabOrder = 0 27 | OnSelectCell = ParamsGridSelectCell 28 | end 29 | object Toolbar: TPanel 30 | Left = 0 31 | Top = 317 32 | Width = 423 33 | Height = 37 34 | Align = alBottom 35 | BevelOuter = bvNone 36 | Caption = 'Toolbar' 37 | ShowCaption = False 38 | TabOrder = 1 39 | object OkButton: TButton 40 | Left = 15 41 | Top = 6 42 | Width = 75 43 | Height = 25 44 | Caption = 'OK' 45 | Default = True 46 | TabOrder = 0 47 | OnClick = OkButtonClick 48 | end 49 | object CancelButton: TButton 50 | Left = 96 51 | Top = 6 52 | Width = 75 53 | Height = 25 54 | Cancel = True 55 | Caption = 'Cancel' 56 | TabOrder = 1 57 | OnClick = CancelButtonClick 58 | end 59 | end 60 | end 61 | -------------------------------------------------------------------------------- /Demos/PascalQuery/Demo.Form.Parameters.pas: -------------------------------------------------------------------------------- 1 | unit Demo.Form.Parameters; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, GraphQL.Core, GraphQL.Resolver.Core, 8 | Vcl.ExtCtrls, Vcl.Grids, Vcl.StdCtrls, System.Rtti; 9 | 10 | type 11 | TParametersForm = class(TForm) 12 | ParamsGrid: TStringGrid; 13 | Toolbar: TPanel; 14 | OkButton: TButton; 15 | CancelButton: TButton; 16 | procedure CancelButtonClick(Sender: TObject); 17 | procedure FormShow(Sender: TObject); 18 | procedure OkButtonClick(Sender: TObject); 19 | procedure ParamsGridSelectCell(Sender: TObject; ACol, ARow: Integer; var 20 | CanSelect: Boolean); 21 | private 22 | FGraphQLVariables: IGraphQLVariables; 23 | FGraphQL: IGraphQL; 24 | public 25 | class function GetVariables(AGraphQL: IGraphQL): IGraphQLVariables; 26 | end; 27 | 28 | implementation 29 | 30 | {$R *.dfm} 31 | 32 | procedure TParametersForm.CancelButtonClick(Sender: TObject); 33 | begin 34 | ModalResult := mrCancel; 35 | end; 36 | 37 | procedure TParametersForm.FormShow(Sender: TObject); 38 | var 39 | LIndex: Integer; 40 | begin 41 | ParamsGrid.RowCount := FGraphQL.ParamCount + 1; 42 | ParamsGrid.Cells[1, 0] := 'Name'; 43 | ParamsGrid.Cells[2, 0] := 'Type'; 44 | ParamsGrid.Cells[3, 0] := 'Value'; 45 | for LIndex := 0 to FGraphQL.ParamCount - 1 do 46 | begin 47 | ParamsGrid.Cells[1, LIndex + 1] := FGraphQL.Params[LIndex].ParamName; 48 | ParamsGrid.Cells[2, LIndex + 1] := VariableTypeToStr(FGraphQL.Params[LIndex].ParamType); 49 | if FGraphQL.Params[LIndex].DefaultValue.IsEmpty then 50 | ParamsGrid.Cells[3, LIndex + 1] := '' 51 | else 52 | ParamsGrid.Cells[3, LIndex + 1] := FGraphQL.Params[LIndex].DefaultValue.ToString; 53 | end; 54 | end; 55 | 56 | { TParametersForm } 57 | 58 | class function TParametersForm.GetVariables( 59 | AGraphQL: IGraphQL): IGraphQLVariables; 60 | var 61 | ParametersForm: TParametersForm; 62 | begin 63 | Result := TGraphQLVariables.Create; 64 | 65 | if AGraphQL.ParamCount > 0 then 66 | begin 67 | ParametersForm := TParametersForm.Create(nil); 68 | try 69 | ParametersForm.FGraphQLVariables := Result; 70 | ParametersForm.FGraphQL := AGraphQL; 71 | if ParametersForm.ShowModal <> mrOk then 72 | Abort; 73 | finally 74 | ParametersForm.Free; 75 | end; 76 | end; 77 | end; 78 | 79 | procedure TParametersForm.OkButtonClick(Sender: TObject); 80 | 81 | function GetParamValue(const AValue: string; AParamType: TGraphQLVariableType): TValue; 82 | begin 83 | case AParamType of 84 | TGraphQLVariableType.StringType: Result := AValue; 85 | TGraphQLVariableType.IntType: Result := StrToInt(AValue); 86 | TGraphQLVariableType.FloatType: Result := StrToFloat(AValue); 87 | TGraphQLVariableType.BooleanType: Result := StrToBool(AValue); 88 | TGraphQLVariableType.IdType: Result := AValue; 89 | else 90 | raise Exception.Create('GetParamValue: unsupported data type'); 91 | end; 92 | end; 93 | 94 | var 95 | LIndex: Integer; 96 | begin 97 | for LIndex := 0 to FGraphQL.ParamCount - 1 do 98 | begin 99 | //FGraphQLVariables.Clear; 100 | FGraphQLVariables.SetVariable(FGraphQL.Params[LIndex].ParamName, GetParamValue(ParamsGrid.Cells[3, LIndex + 1], FGraphQL.Params[LIndex].ParamType)) 101 | end; 102 | 103 | ModalResult := mrOk; 104 | end; 105 | 106 | procedure TParametersForm.ParamsGridSelectCell(Sender: TObject; ACol, ARow: 107 | Integer; var CanSelect: Boolean); 108 | begin 109 | if ACol = 3 then 110 | ParamsGrid.Options := ParamsGrid.Options + [goEditing] 111 | else 112 | ParamsGrid.Options := ParamsGrid.Options - [goEditing]; 113 | end; 114 | 115 | end. 116 | -------------------------------------------------------------------------------- /Demos/PascalQuery/Demo.Form.RttiQuery.dfm: -------------------------------------------------------------------------------- 1 | object RttiQueryForm: TRttiQueryForm 2 | Left = 0 3 | Top = 0 4 | Caption = 'RTTI Demo' 5 | ClientHeight = 450 6 | ClientWidth = 905 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -13 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | KeyPreview = True 14 | OldCreateOrder = True 15 | OnCreate = FormCreate 16 | OnKeyUp = FormKeyUp 17 | DesignSize = ( 18 | 905 19 | 450) 20 | PixelsPerInch = 96 21 | TextHeight = 16 22 | object Label1: TLabel 23 | Left = 8 24 | Top = 63 25 | Width = 74 26 | Height = 16 27 | Caption = 'Choose a file' 28 | end 29 | object SourceMemo: TMemo 30 | Left = 8 31 | Top = 85 32 | Width = 433 33 | Height = 303 34 | Anchors = [akLeft, akTop, akBottom] 35 | Font.Charset = DEFAULT_CHARSET 36 | Font.Color = clWindowText 37 | Font.Height = -16 38 | Font.Name = 'Consolas' 39 | Font.Style = [] 40 | ParentFont = False 41 | ScrollBars = ssBoth 42 | TabOrder = 0 43 | WordWrap = False 44 | end 45 | object RunQueryButton: TButton 46 | Left = 8 47 | Top = 394 48 | Width = 193 49 | Height = 47 50 | Anchors = [akLeft, akBottom] 51 | Caption = 'Execute GraphQL query (F5)' 52 | TabOrder = 1 53 | OnClick = RunQueryButtonClick 54 | end 55 | object ResultMemo: TMemo 56 | Left = 459 57 | Top = 85 58 | Width = 433 59 | Height = 303 60 | Anchors = [akLeft, akTop, akRight, akBottom] 61 | Font.Charset = DEFAULT_CHARSET 62 | Font.Color = clWindowText 63 | Font.Height = -16 64 | Font.Name = 'Consolas' 65 | Font.Style = [] 66 | ParentFont = False 67 | ReadOnly = True 68 | ScrollBars = ssBoth 69 | TabOrder = 2 70 | WordWrap = False 71 | end 72 | object FilesComboBox: TComboBox 73 | Left = 88 74 | Top = 58 75 | Width = 353 76 | Height = 24 77 | TabOrder = 3 78 | OnChange = FilesComboBoxChange 79 | end 80 | object Panel1: TPanel 81 | Left = 0 82 | Top = 0 83 | Width = 905 84 | Height = 52 85 | Align = alTop 86 | BevelOuter = bvNone 87 | Caption = 'Panel1' 88 | Color = clWhite 89 | ParentBackground = False 90 | ShowCaption = False 91 | TabOrder = 4 92 | object Label2: TLabel 93 | Left = 59 94 | Top = 3 95 | Width = 181 96 | Height = 25 97 | Caption = 'GraphQL for Delphi' 98 | Font.Charset = DEFAULT_CHARSET 99 | Font.Color = 9961697 100 | Font.Height = -21 101 | Font.Name = 'Tahoma' 102 | Font.Style = [] 103 | ParentFont = False 104 | end 105 | object Label3: TLabel 106 | Left = 59 107 | Top = 30 108 | Width = 68 109 | Height = 16 110 | Caption = 'RTTI Demo' 111 | Font.Charset = DEFAULT_CHARSET 112 | Font.Color = 9961697 113 | Font.Height = -13 114 | Font.Name = 'Tahoma' 115 | Font.Style = [fsBold] 116 | ParentFont = False 117 | end 118 | object Image1: TImage 119 | Left = 8 120 | Top = 3 121 | Width = 41 122 | Height = 46 123 | AutoSize = True 124 | Picture.Data = { 125 | 0954506E67496D61676589504E470D0A1A0A0000000D49484452000000290000 126 | 002E0806000000B565304E0000000970485973000006EB000006EB014C319E4A 127 | 0000001974455874536F667477617265007777772E696E6B73636170652E6F72 128 | 679BEE3C1A000006B54944415478DADD590D6C535514FEEE5BB72112220490BF 129 | AD05C31C8A3A05C41FB28009642AF1171188FF81B56340801005813004A26070 130 | 8BB0B51D0A0615C34F14A382208A1832515140E547846CDD40A698628802EDB6 131 | F7FCEE5E1FBC757DEDD676CC7892977B7B7FCEF9EEB9E79C7BEEAD401248C3C6 132 | 141FCECE12D026F3A7835F950694DBD1B558605C43A2FC453240FAE0799BC513 133 | 11BADEB1C3F564BB83AC82772435F88555BF0A6D643F147CD9AE207DF02EE386 134 | 3F1F45C4723B9C2FB433484F318B1951869470CB67B61BC89328CF6A80FA1EAB 135 | B74519F613CD6162260A7EBEA2207D28EB02280B599DC22F954C547AB3D27CA4 136 | A652846CAFE357C6618BEC9872B64D416A2852AAD1537AF1ABFC7AE8C23537D9 137 | F4667DAC06A1516BC228D9BE81C08EB29436D9819F9FDF4B99A82D1528AA4F3A 138 | 48E9C52C4A28FCE650D3C70262060151B87A4002AE87186683A0F66C546CF05B 139 | 098C4172703A1AFCF5B02DE5828C7074548332CB81FC6DAD02590DCF1072CF53 140 | A0A55178455F38B7B3D44EA134235C00F76F66065C9FEA5BEFD9C162145915D1 141 | 8B1719FC7C7017B14D9AC49E4C387325AF4AB847A440947005B79817CAFE131A 142 | 35EFC36ACA6FB85385080AA8DB681ADF3782D43B3D54BF28688A5EEC665F05AB 143 | 33ADB68AF3C6B2D8C4EF643A3A66F7C453FF18F36BF0DA552AAE3EC2C5D9F9F3 144 | 317AF8666B9351DFA4490F627D7853F34219173E55029CC6DFAF47D1B604B426 145 | 15625E6F38FF341A2BB1B68382C06156FB713BC667C2B5217C6235DCE3690ED2 146 | FB6B383F9BF3CF9BE65FC3F973A087AF742BE19CDF0892AB45B685356829D0EE 147 | EE0BD7D7CD6DD4339FE016934D05010E97DB198903F9EF6691CBCE050EB89684 148 | F79F46F9D020D46F60E91FE2880419602DCD6A2534FC9CFE701D34B7D5C0DD87 149 | 7643AF4547721E4690FBACE657C17D2B17F01DAB013AD6C0EBE0AC36F757A23C 150 | 4781BA3FCA4E0624C813ACF4B718A0729BAE356FB3AE1DEF3ADD91B437EC2898 151 | 8C1844275A4D8D4C428484E334D6740F22588B8871B65193C74535BC2FD24196 152 | 46EC06DEA7961E6DBAF2B23B1428D2A1FE56D190D50F85B5B1401E87BB07177B 153 | 8CD5CEE49A4B67D8D374119E2D2C1EB4003997865464AB41CF0DB49947C27A0F 154 | A4216D742F3C77C6689091808BDACBEAED34E8D90E3857C40268106D78B6D03D 155 | FA074688A18C10AA791136289F9962B0419B3976823084FB507E1F07AD97ABA5 156 | DEA79F4357EF8D181734CFA0B73E43706BE5160411183400D3032D0579081BD3 157 | 3AC1FF23ABD753CEB33CCBDF0AEFEF0CBF53D523CD392A6D021D6D6B68479BA8 158 | BDD13EA9C11E660D4AFA03A59D2E40F9451E81043A865AFCA4A5002FF3778FE1 159 | FC8F58FD9D76983540EAC244BFC1DBAD0E9A945B49DBBDE4272D0649012F7338 160 | E39AB693CE32AAB5004DBBB1958BBC977C5E219FB94903C9AC87139443ACDA58 161 | E6D8917F285E9095F066F3E895DBAED1AC06F178FD35292069F41F70E043D440 162 | 31B77956BC004D721A1365DADD16DADDC309836430BE87C1F87356FD0A6C0332 163 | 30C99F284879240A5C3C46BEDDE9447974A2ED71839457D56AF8E569701377C7 164 | 451BF2260AD020665D2E6A92B9280E9F81C81902675D5C20A9C5A95CED4A0E3A 165 | 9881AE839371873648CF867A31E7D40633044E73A06055AB41067191D98F224F 166 | 896EC9B89646221EAF4CCDB4AF58FD8B2752966C6B15C83A0417723B0AF97B13 167 | 278C4B3640934C998F8E25905266F5452D06C9B379840A7527EBF5D4E2406AB1 168 | AAAD40EA997F8ACCA8D2B9EDA3434EDA1CA47E267BEE67887957E849804F66D4 169 | AC2F6182B1A0AD001A44D98BB96BF389C34790CCE4351E8BCA44C6E3AD324F15 170 | FBE04DED066DA38C83E689045CA741CD6A4B2D1AC4BB8F83601892906A6E9759 171 | 58066A1F179733ECE6141E6CDB8AE8401F52DA0391FA087E5E8CA457C8A36B25 172 | EDF2421B62EC483953D1784F8F4827625E1FFE0314887A11D36F56C2CD251E68 173 | 2B04BC5FE7F0BE5410E595E2B0304E95287C225E691325D39556DEEB2D7792E0 174 | 0B438F03DE55427F7C32D32E7E7B11E571201E8AF2387003EBB9E6A1545E6906 175 | F2A75FD23273469ECD228FA1278D994905F3BC1D56CF2CAD79C73193D57B92F1 176 | CC5203CF68CABF8B6D011E26DB789EEF0F69B3E50298AC16477AC7312DB40BDB 177 | FA50E029F3135FACF7A4589494A7BF7A0457D890BE9CBFE5DB500ABF066A6453 178 | 0A3ACC56717EF2157BFA3353B8D153BB75E1A745883D6F9B9A748A849C2FA1E7 179 | E82A940EE4B5673D6D2CC75AFB82E1AB7EA2038547E295F3FF7FD8D741C6FA8B 180 | 04CB08724EBB8294AFB70AC42EAB7E999B32D6ED6E5790922EBFB235A375D4E2 181 | D389F24F0AC8D01FA0B44B2D9F0C1DF4F62AC6412F73C112F3C354BCF42F0DB7 182 | E82AFDD032BE0000000049454E44AE426082} 183 | end 184 | end 185 | end 186 | -------------------------------------------------------------------------------- /Demos/PascalQuery/Demo.Form.RttiQuery.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi GraphQL } 4 | { Copyright (c) 2022 Luca Minuti } 5 | { https://github.com/lminuti/graphql } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | unit Demo.Form.RttiQuery; 23 | 24 | interface 25 | 26 | uses 27 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, 28 | System.Classes, System.Rtti, System.Types, System.IOUtils, Vcl.Graphics, 29 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, GraphQL.Core, GraphQL.Query, 30 | GraphQL.Resolver.Core, Vcl.ExtCtrls, Vcl.Imaging.pngimage; 31 | 32 | type 33 | TRttiQueryForm = class(TForm) 34 | SourceMemo: TMemo; 35 | RunQueryButton: TButton; 36 | ResultMemo: TMemo; 37 | Label1: TLabel; 38 | FilesComboBox: TComboBox; 39 | Panel1: TPanel; 40 | Label2: TLabel; 41 | Label3: TLabel; 42 | Image1: TImage; 43 | procedure FilesComboBoxChange(Sender: TObject); 44 | procedure FormCreate(Sender: TObject); 45 | procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 46 | procedure RunQueryButtonClick(Sender: TObject); 47 | private 48 | FSampleDir: string; 49 | FQuery: TGraphQLQuery; 50 | procedure ReadFiles; 51 | public 52 | constructor Create(AOwner: TComponent); override; 53 | destructor Destroy; override; 54 | end; 55 | 56 | var 57 | RttiQueryForm: TRttiQueryForm; 58 | 59 | implementation 60 | 61 | {$R *.dfm} 62 | 63 | uses 64 | System.JSON, REST.Json, 65 | Demo.API.Test, GraphQL.Utils.JSON, GraphQL.Resolver.Rtti, 66 | Demo.Form.Parameters; 67 | 68 | type 69 | TTestApiResolver = class(TInterfacedObject, IGraphQLResolver) 70 | private 71 | FTestApi: TTestApi; 72 | public 73 | function Resolve(AContext: TObject; AParams: TGraphQLParams): TValue; 74 | 75 | constructor Create; 76 | destructor Destroy; override; 77 | end; 78 | 79 | 80 | { TRttiQueryForm } 81 | 82 | constructor TRttiQueryForm.Create(AOwner: TComponent); 83 | begin 84 | inherited; 85 | FQuery := TGraphQLQuery.Create; 86 | 87 | FQuery.RegisterResolver(TTestApiResolver.Create); 88 | 89 | FQuery.RegisterResolver(TGraphQLRttiResolver.Create(TTestApi, True)); 90 | 91 | FQuery.RegisterFunction('rollDice', 92 | function (AContext: TObject; AParams: TGraphQLParams) :TValue 93 | begin 94 | Result := RollDice(AParams.Get('numDice').AsInteger, AParams.Get('numSides').AsInteger); 95 | end 96 | ); 97 | 98 | FQuery.RegisterFunction('reverseString', 99 | function (AContext: TObject; AParams: TGraphQLParams) :TValue 100 | begin 101 | Result := ReverseString(AParams.Get('value').AsString); 102 | end 103 | ); 104 | 105 | FQuery.RegisterFunction('hero', 106 | function (AContext: TObject; AParams: TGraphQLParams) :TValue 107 | begin 108 | if AParams.Exists('id') then 109 | Result := StarWarsHero(AParams.Get('id').AsString) 110 | else if AParams.Exists('episode') then 111 | Result := TValue.From(StarWarsHeroByEpisode(AParams.Get('episode').AsString)) 112 | else 113 | Result := StarWarsHero('1000'); 114 | end 115 | ); 116 | 117 | end; 118 | 119 | procedure TRttiQueryForm.FormCreate(Sender: TObject); 120 | begin 121 | ReadFiles; 122 | end; 123 | 124 | destructor TRttiQueryForm.Destroy; 125 | begin 126 | FQuery.Free; 127 | inherited; 128 | end; 129 | 130 | procedure TRttiQueryForm.FilesComboBoxChange(Sender: TObject); 131 | var 132 | LFileName: string; 133 | begin 134 | if FilesComboBox.Text <> '' then 135 | begin 136 | LFileName := FSampleDir + PathDelim + FilesComboBox.Text; 137 | if FileExists(LFileName) then 138 | SourceMemo.Lines.LoadFromFile(LFileName); 139 | end; 140 | end; 141 | 142 | procedure TRttiQueryForm.FormKeyUp(Sender: TObject; var Key: Word; Shift: 143 | TShiftState); 144 | begin 145 | if Key = VK_F5 then 146 | RunQueryButton.Click; 147 | end; 148 | 149 | procedure TRttiQueryForm.ReadFiles; 150 | var 151 | LFiles: TStringDynArray; 152 | LFileName: string; 153 | begin 154 | FSampleDir := ExtractFileDir( ParamStr(0)) + PathDelim + '..' + PathDelim + '..' + PathDelim + '..' + PathDelim + 'Files'; 155 | 156 | FilesComboBox.Items.Clear; 157 | LFiles := TDirectory.GetFiles(FSampleDir); 158 | for LFileName in LFiles do 159 | begin 160 | if not LFileName.Contains('dbquery') then 161 | FilesComboBox.Items.Add(ExtractFileName(LFileName)); 162 | end; 163 | end; 164 | 165 | procedure TRttiQueryForm.RunQueryButtonClick(Sender: TObject); 166 | var 167 | LGraphQL: IGraphQL; 168 | LVariables: IGraphQLVariables; 169 | begin 170 | LGraphQL := FQuery.Parse(SourceMemo.Text); 171 | LVariables := TParametersForm.GetVariables(LGraphQL); 172 | 173 | ResultMemo.Text := TJSONHelper.PrettyPrint(FQuery.Run(LGraphQL, LVariables)); 174 | end; 175 | 176 | { TTestApiResolver } 177 | 178 | constructor TTestApiResolver.Create; 179 | begin 180 | FTestApi := TTestApi.Create; 181 | end; 182 | 183 | destructor TTestApiResolver.Destroy; 184 | begin 185 | FTestApi.Free; 186 | inherited; 187 | end; 188 | 189 | function TTestApiResolver.Resolve(AContext: TObject; AParams: TGraphQLParams): TValue; 190 | begin 191 | if AParams.FieldName = 'help' then 192 | begin 193 | Result := FTestApi.Help; 194 | end; 195 | end; 196 | 197 | end. 198 | -------------------------------------------------------------------------------- /Demos/PascalQuery/RttiQuery.dpr: -------------------------------------------------------------------------------- 1 | program RttiQuery; 2 | 3 | uses 4 | Vcl.Forms, 5 | Demo.Form.RttiQuery in 'Demo.Form.RttiQuery.pas' {RttiQueryForm}, 6 | Demo.API.Test in 'Demo.API.Test.pas', 7 | GraphQL.Classes in '..\..\Source\GraphQL.Classes.pas', 8 | GraphQL.Core in '..\..\Source\GraphQL.Core.pas', 9 | GraphQL.Lexer.Core in '..\..\Source\GraphQL.Lexer.Core.pas', 10 | GraphQL.SyntaxAnalysis.Builder in '..\..\Source\GraphQL.SyntaxAnalysis.Builder.pas', 11 | GraphQL.SyntaxAnalysis.Core in '..\..\Source\GraphQL.SyntaxAnalysis.Core.pas', 12 | GraphQL.Utils.JSON in '..\..\Source\GraphQL.Utils.JSON.pas', 13 | GraphQL.Resolver.Core in '..\..\Source\GraphQL.Resolver.Core.pas', 14 | GraphQL.Resolver.Rtti in '..\..\Source\GraphQL.Resolver.Rtti.pas', 15 | GraphQL.Core.Attributes in '..\..\Source\GraphQL.Core.Attributes.pas', 16 | GraphQL.Utils.Rtti in '..\..\Source\GraphQL.Utils.Rtti.pas', 17 | GraphQL.Query in '..\..\Source\GraphQL.Query.pas', 18 | Demo.Form.Parameters in 'Demo.Form.Parameters.pas' {ParametersForm}; 19 | 20 | {$R *.res} 21 | 22 | begin 23 | ReportMemoryLeaksOnShutdown := True; 24 | Application.Initialize; 25 | Application.MainFormOnTaskbar := True; 26 | Application.CreateForm(TRttiQueryForm, RttiQueryForm); 27 | Application.Run; 28 | end. 29 | -------------------------------------------------------------------------------- /Demos/PascalQuery/RttiQuery.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lminuti/graphql/4eeb388880f8abfd5faccc92a1783191de077a7a/Demos/PascalQuery/RttiQuery.res -------------------------------------------------------------------------------- /Demos/Proxy/Demo.Form.Parameters.dfm: -------------------------------------------------------------------------------- 1 | object ParametersForm: TParametersForm 2 | Left = 0 3 | Top = 0 4 | BorderStyle = bsDialog 5 | Caption = 'Parameters' 6 | ClientHeight = 354 7 | ClientWidth = 423 8 | Color = clBtnFace 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'Tahoma' 13 | Font.Style = [] 14 | OldCreateOrder = False 15 | Position = poScreenCenter 16 | OnShow = FormShow 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | object ParamsGrid: TStringGrid 20 | Left = 0 21 | Top = 0 22 | Width = 423 23 | Height = 317 24 | Align = alClient 25 | Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing] 26 | TabOrder = 0 27 | OnSelectCell = ParamsGridSelectCell 28 | end 29 | object Toolbar: TPanel 30 | Left = 0 31 | Top = 317 32 | Width = 423 33 | Height = 37 34 | Align = alBottom 35 | BevelOuter = bvNone 36 | Caption = 'Toolbar' 37 | ShowCaption = False 38 | TabOrder = 1 39 | object OkButton: TButton 40 | Left = 15 41 | Top = 6 42 | Width = 75 43 | Height = 25 44 | Caption = 'OK' 45 | Default = True 46 | TabOrder = 0 47 | OnClick = OkButtonClick 48 | end 49 | object CancelButton: TButton 50 | Left = 96 51 | Top = 6 52 | Width = 75 53 | Height = 25 54 | Cancel = True 55 | Caption = 'Cancel' 56 | TabOrder = 1 57 | OnClick = CancelButtonClick 58 | end 59 | end 60 | end 61 | -------------------------------------------------------------------------------- /Demos/Proxy/Demo.Form.Parameters.pas: -------------------------------------------------------------------------------- 1 | unit Demo.Form.Parameters; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, 7 | System.Classes, System.Json, Vcl.Graphics, 8 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, GraphQL.Core, GraphQL.Resolver.Core, 9 | Vcl.ExtCtrls, Vcl.Grids, Vcl.StdCtrls, System.Rtti; 10 | 11 | type 12 | TParametersForm = class(TForm) 13 | ParamsGrid: TStringGrid; 14 | Toolbar: TPanel; 15 | OkButton: TButton; 16 | CancelButton: TButton; 17 | procedure CancelButtonClick(Sender: TObject); 18 | procedure FormShow(Sender: TObject); 19 | procedure OkButtonClick(Sender: TObject); 20 | procedure ParamsGridSelectCell(Sender: TObject; ACol, ARow: Integer; var 21 | CanSelect: Boolean); 22 | private 23 | FVariables: string; 24 | FGraphQL: IGraphQL; 25 | public 26 | class function GetVariables(const AGraphQL: string): string; 27 | end; 28 | 29 | implementation 30 | 31 | {$R *.dfm} 32 | 33 | uses 34 | GraphQL.SyntaxAnalysis.Builder; 35 | 36 | procedure TParametersForm.CancelButtonClick(Sender: TObject); 37 | begin 38 | ModalResult := mrCancel; 39 | end; 40 | 41 | procedure TParametersForm.FormShow(Sender: TObject); 42 | var 43 | LIndex: Integer; 44 | LDefaultValue: TValue; 45 | begin 46 | ParamsGrid.RowCount := FGraphQL.ParamCount + 1; 47 | ParamsGrid.Cells[1, 0] := 'Name'; 48 | ParamsGrid.Cells[2, 0] := 'Type'; 49 | ParamsGrid.Cells[3, 0] := 'Value'; 50 | for LIndex := 0 to FGraphQL.ParamCount - 1 do 51 | begin 52 | LDefaultValue := FGraphQL.Params[LIndex].DefaultValue; 53 | 54 | ParamsGrid.Cells[1, LIndex + 1] := FGraphQL.Params[LIndex].ParamName; 55 | ParamsGrid.Cells[2, LIndex + 1] := VariableTypeToStr(FGraphQL.Params[LIndex].ParamType); 56 | if LDefaultValue.IsEmpty then 57 | ParamsGrid.Cells[3, LIndex + 1] := '' 58 | else 59 | ParamsGrid.Cells[3, LIndex + 1] := LDefaultValue.ToString; 60 | end; 61 | end; 62 | 63 | { TParametersForm } 64 | 65 | class function TParametersForm.GetVariables(const AGraphQL: string): string; 66 | var 67 | LBuilder: TGraphQLBuilder; 68 | LGraphQL: IGraphQL; 69 | ParametersForm: TParametersForm; 70 | begin 71 | Result := ''; 72 | LBuilder := TGraphQLBuilder.Create(AGraphQL); 73 | try 74 | LGraphQL := LBuilder.Build; 75 | 76 | if LGraphQL.ParamCount > 0 then 77 | begin 78 | ParametersForm := TParametersForm.Create(nil); 79 | try 80 | ParametersForm.FGraphQL := LGraphQL; 81 | if ParametersForm.ShowModal <> mrOk then 82 | Abort; 83 | 84 | Result := ParametersForm.FVariables; 85 | 86 | finally 87 | ParametersForm.Free; 88 | end; 89 | end; 90 | 91 | finally 92 | LBuilder.Free; 93 | end; 94 | 95 | end; 96 | 97 | procedure TParametersForm.OkButtonClick(Sender: TObject); 98 | var 99 | LIndex: Integer; 100 | LVariablesJson: TJSONObject; 101 | LJsonValue: TJSONValue; 102 | LValue: string; 103 | begin 104 | LVariablesJson := TJSONObject.Create; 105 | try 106 | for LIndex := 0 to FGraphQL.ParamCount - 1 do 107 | begin 108 | LValue := ParamsGrid.Cells[3, LIndex + 1]; 109 | case FGraphQL.Params[LIndex].ParamType of 110 | TGraphQLVariableType.StringType: LJsonValue := TJSONString.Create(LValue); 111 | TGraphQLVariableType.IntType: LJsonValue := TJSONNumber.Create(StrToInt(LValue)); 112 | TGraphQLVariableType.FloatType: LJsonValue := TJSONNumber.Create(StrToFloat(LValue)); 113 | TGraphQLVariableType.BooleanType: LJsonValue := TJSONBool.Create(StrToBool(LValue)) ; 114 | TGraphQLVariableType.IdType: LJsonValue := TJSONString.Create(LValue); 115 | else 116 | raise Exception.Create('Unsupported datatype'); 117 | end; 118 | LVariablesJson.AddPair(FGraphQL.Params[LIndex].ParamName, LJsonValue); 119 | end; 120 | FVariables := LVariablesJson.ToJSON; 121 | finally 122 | LVariablesJson.Free; 123 | end; 124 | 125 | ModalResult := mrOk; 126 | end; 127 | 128 | procedure TParametersForm.ParamsGridSelectCell(Sender: TObject; ACol, ARow: 129 | Integer; var CanSelect: Boolean); 130 | begin 131 | if ACol = 3 then 132 | ParamsGrid.Options := ParamsGrid.Options + [goEditing] 133 | else 134 | ParamsGrid.Options := ParamsGrid.Options - [goEditing]; 135 | end; 136 | 137 | end. 138 | -------------------------------------------------------------------------------- /Demos/Proxy/Demo.Form.ProxyClient.dfm: -------------------------------------------------------------------------------- 1 | object MainProxyForm: TMainProxyForm 2 | Left = 0 3 | Top = 0 4 | Caption = 'ReST API Demo' 5 | ClientHeight = 614 6 | ClientWidth = 906 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -13 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | KeyPreview = True 14 | OldCreateOrder = False 15 | OnKeyUp = FormKeyUp 16 | DesignSize = ( 17 | 906 18 | 614) 19 | PixelsPerInch = 96 20 | TextHeight = 16 21 | object Label1: TLabel 22 | Left = 480 23 | Top = 67 24 | Width = 402 25 | Height = 19 26 | Caption = 'This demo will create a proxy server with a built-in client' 27 | Font.Charset = DEFAULT_CHARSET 28 | Font.Color = clWindowText 29 | Font.Height = -16 30 | Font.Name = 'Tahoma' 31 | Font.Style = [] 32 | ParentFont = False 33 | end 34 | object Label2: TLabel 35 | Left = 16 36 | Top = 87 37 | Width = 58 38 | Height = 16 39 | Caption = 'Proxy port' 40 | end 41 | object lblLink: TLabel 42 | Left = 596 43 | Top = 100 44 | Width = 269 45 | Height = 19 46 | Cursor = crHandPoint 47 | Caption = 'https://jsonplaceholder.typicode.com/' 48 | Font.Charset = DEFAULT_CHARSET 49 | Font.Color = clBlue 50 | Font.Height = -16 51 | Font.Name = 'Tahoma' 52 | Font.Style = [fsUnderline] 53 | ParentFont = False 54 | OnClick = lblLinkClick 55 | end 56 | object Label3: TLabel 57 | Left = 480 58 | Top = 98 59 | Width = 110 60 | Height = 19 61 | Caption = 'Test data from:' 62 | Font.Charset = DEFAULT_CHARSET 63 | Font.Color = clWindowText 64 | Font.Height = -16 65 | Font.Name = 'Tahoma' 66 | Font.Style = [] 67 | ParentFont = False 68 | end 69 | object SourceMemo: TMemo 70 | Left = 8 71 | Top = 130 72 | Width = 433 73 | Height = 329 74 | Anchors = [akLeft, akTop, akBottom] 75 | Font.Charset = DEFAULT_CHARSET 76 | Font.Color = clWindowText 77 | Font.Height = -16 78 | Font.Name = 'Consolas' 79 | Font.Style = [] 80 | Lines.Strings = ( 81 | 'query userAndTodo($id: Int = 1)' 82 | '{' 83 | ' users(id:$id) {' 84 | ' id' 85 | ' name' 86 | ' address {' 87 | ' city' 88 | ' }' 89 | ' todos(completed: true) {' 90 | ' title' 91 | ' completed' 92 | ' userId' 93 | ' }' 94 | ' posts {' 95 | ' title' 96 | ' body' 97 | ' userId' 98 | ' }' 99 | ' }' 100 | '}') 101 | ParentFont = False 102 | ScrollBars = ssBoth 103 | TabOrder = 0 104 | WordWrap = False 105 | end 106 | object RunQueryButton: TButton 107 | Left = 8 108 | Top = 559 109 | Width = 153 110 | Height = 47 111 | Anchors = [akLeft, akBottom] 112 | Caption = 'Run GraphQL query (F5)' 113 | TabOrder = 1 114 | OnClick = RunQueryButtonClick 115 | end 116 | object ResultMemo: TMemo 117 | Left = 459 118 | Top = 130 119 | Width = 439 120 | Height = 329 121 | Anchors = [akLeft, akTop, akRight, akBottom] 122 | Font.Charset = DEFAULT_CHARSET 123 | Font.Color = clWindowText 124 | Font.Height = -16 125 | Font.Name = 'Consolas' 126 | Font.Style = [] 127 | ParentFont = False 128 | ReadOnly = True 129 | ScrollBars = ssBoth 130 | TabOrder = 2 131 | WordWrap = False 132 | end 133 | object btnStart: TButton 134 | Left = 213 135 | Top = 78 136 | Width = 89 137 | Height = 34 138 | Caption = 'Start' 139 | TabOrder = 3 140 | OnClick = btnStartClick 141 | end 142 | object btnStop: TButton 143 | Left = 308 144 | Top = 78 145 | Width = 89 146 | Height = 34 147 | Caption = 'Stop' 148 | TabOrder = 4 149 | OnClick = btnStopClick 150 | end 151 | object edtPort: TEdit 152 | Left = 86 153 | Top = 84 154 | Width = 121 155 | Height = 24 156 | NumbersOnly = True 157 | TabOrder = 5 158 | Text = '8081' 159 | end 160 | object memLog: TMemo 161 | Left = 8 162 | Top = 465 163 | Width = 890 164 | Height = 88 165 | Anchors = [akLeft, akRight, akBottom] 166 | Font.Charset = DEFAULT_CHARSET 167 | Font.Color = clWindowText 168 | Font.Height = -16 169 | Font.Name = 'Consolas' 170 | Font.Style = [] 171 | ParentFont = False 172 | ReadOnly = True 173 | ScrollBars = ssBoth 174 | TabOrder = 6 175 | WordWrap = False 176 | end 177 | object Panel1: TPanel 178 | Left = 0 179 | Top = 0 180 | Width = 906 181 | Height = 52 182 | Align = alTop 183 | BevelOuter = bvNone 184 | Caption = 'Panel1' 185 | Color = clWhite 186 | ParentBackground = False 187 | ShowCaption = False 188 | TabOrder = 7 189 | object Image1: TImage 190 | Left = 8 191 | Top = 3 192 | Width = 41 193 | Height = 46 194 | AutoSize = True 195 | Picture.Data = { 196 | 0954506E67496D61676589504E470D0A1A0A0000000D49484452000000290000 197 | 002E0806000000B565304E0000000970485973000006EB000006EB014C319E4A 198 | 0000001974455874536F667477617265007777772E696E6B73636170652E6F72 199 | 679BEE3C1A000006B54944415478DADD590D6C535514FEEE5BB72112220490BF 200 | AD05C31C8A3A05C41FB28009642AF1171188FF81B56340801005813004A26070 201 | 8BB0B51D0A0615C34F14A382208A1832515140E547846CDD40A698628802EDB6 202 | F7FCEE5E1FBC757DEDD676CC7892977B7B7FCEF9EEB9E79C7BEEAD401248C3C6 203 | 141FCECE12D026F3A7835F950694DBD1B558605C43A2FC453240FAE0799BC513 204 | 11BADEB1C3F564BB83AC82772435F88555BF0A6D643F147CD9AE207DF02EE386 205 | 3F1F45C4723B9C2FB433484F318B1951869470CB67B61BC89328CF6A80FA1EAB 206 | B74519F613CD6162260A7EBEA2207D28EB02280B599DC22F954C547AB3D27CA4 207 | A652846CAFE357C6618BEC9872B64D416A2852AAD1537AF1ABFC7AE8C23537D9 208 | F4667DAC06A1516BC228D9BE81C08EB29436D9819F9FDF4B99A82D1528AA4F3A 209 | 48E9C52C4A28FCE650D3C70262060151B87A4002AE87186683A0F66C546CF05B 210 | 098C4172703A1AFCF5B02DE5828C7074548332CB81FC6DAD02590DCF1072CF53 211 | A0A55178455F38B7B3D44EA134235C00F76F66065C9FEA5BEFD9C162145915D1 212 | 8B1719FC7C7017B14D9AC49E4C387325AF4AB847A440947005B79817CAFE131A 213 | 35EFC36ACA6FB85385080AA8DB681ADF3782D43B3D54BF28688A5EEC665F05AB 214 | 33ADB68AF3C6B2D8C4EF643A3A66F7C453FF18F36BF0DA552AAE3EC2C5D9F9F3 215 | 317AF8666B9351DFA4490F627D7853F34219173E55029CC6DFAF47D1B604B426 216 | 15625E6F38FF341A2BB1B68382C06156FB713BC667C2B5217C6235DCE3690ED2 217 | FB6B383F9BF3CF9BE65FC3F973A087AF742BE19CDF0892AB45B685356829D0EE 218 | EE0BD7D7CD6DD4339FE016934D05010E97DB198903F9EF6691CBCE050EB89684 219 | F79F46F9D020D46F60E91FE2880419602DCD6A2534FC9CFE701D34B7D5C0DD87 220 | 7643AF4547721E4690FBACE657C17D2B17F01DAB013AD6C0EBE0AC36F757A23C 221 | 4781BA3FCA4E0624C813ACF4B718A0729BAE356FB3AE1DEF3ADD91B437EC2898 222 | 8C1844275A4D8D4C428484E334D6740F22588B8871B65193C74535BC2FD24196 223 | 46EC06DEA7961E6DBAF2B23B1428D2A1FE56D190D50F85B5B1401E87BB07177B 224 | 8CD5CEE49A4B67D8D374119E2D2C1EB4003997865464AB41CF0DB49947C27A0F 225 | A4216D742F3C77C6689091808BDACBEAED34E8D90E3857C40268106D78B6D03D 226 | FA074688A18C10AA791136289F9962B0419B3976823084FB507E1F07AD97ABA5 227 | DEA79F4357EF8D181734CFA0B73E43706BE5160411183400D3032D0579081BD3 228 | 3AC1FF23ABD753CEB33CCBDF0AEFEF0CBF53D523CD392A6D021D6D6B68479BA8 229 | BDD13EA9C11E660D4AFA03A59D2E40F9451E81043A865AFCA4A5002FF3778FE1 230 | FC8F58FD9D76983540EAC244BFC1DBAD0E9A945B49DBBDE4272D0649012F7338 231 | E39AB693CE32AAB5004DBBB1958BBC977C5E219FB94903C9AC87139443ACDA58 232 | E6D8917F285E9095F066F3E895DBAED1AC06F178FD35292069F41F70E043D440 233 | 31B77956BC004D721A1365DADD16DADDC309836430BE87C1F87356FD0A6C0332 234 | 30C99F284879240A5C3C46BEDDE9447974A2ED71839457D56AF8E569701377C7 235 | 451BF2260AD020665D2E6A92B9280E9F81C81902675D5C20A9C5A95CED4A0E3A 236 | 9881AE839371873648CF867A31E7D40633044E73A06055AB41067191D98F224F 237 | 896EC9B89646221EAF4CCDB4AF58FD8B2752966C6B15C83A0417723B0AF97B13 238 | 278C4B3640934C998F8E25905266F5452D06C9B379840A7527EBF5D4E2406AB1 239 | AAAD40EA997F8ACCA8D2B9EDA3434EDA1CA47E267BEE67887957E849804F66D4 240 | AC2F6182B1A0AD001A44D98BB96BF389C34790CCE4351E8BCA44C6E3AD324F15 241 | FBE04DED066DA38C83E689045CA741CD6A4B2D1AC4BB8F83601892906A6E9759 242 | 58066A1F179733ECE6141E6CDB8AE8401F52DA0391FA087E5E8CA457C8A36B25 243 | EDF2421B62EC483953D1784F8F4827625E1FFE0314887A11D36F56C2CD251E68 244 | 2B04BC5FE7F0BE5410E595E2B0304E95287C225E691325D39556DEEB2D7792E0 245 | 0B438F03DE55427F7C32D32E7E7B11E571201E8AF2387003EBB9E6A1545E6906 246 | F2A75FD23273469ECD228FA1278D994905F3BC1D56CF2CAD79C73193D57B92F1 247 | CC5203CF68CABF8B6D011E26DB789EEF0F69B3E50298AC16477AC7312DB40BDB 248 | FA50E029F3135FACF7A4589494A7BF7A0457D890BE9CBFE5DB500ABF066A6453 249 | 0A3ACC56717EF2157BFA3353B8D153BB75E1A745883D6F9B9A748A849C2FA1E7 250 | E82A940EE4B5673D6D2CC75AFB82E1AB7EA2038547E295F3FF7FD8D741C6FA8B 251 | 04CB08724EBB8294AFB70AC42EAB7E999B32D6ED6E5790922EBFB235A375D4E2 252 | D389F24F0AC8D01FA0B44B2D9F0C1DF4F62AC6412F73C112F3C354BCF42F0DB7 253 | E82AFDD032BE0000000049454E44AE426082} 254 | end 255 | object Label4: TLabel 256 | Left = 59 257 | Top = 3 258 | Width = 181 259 | Height = 25 260 | Caption = 'GraphQL for Delphi' 261 | Font.Charset = DEFAULT_CHARSET 262 | Font.Color = 9961697 263 | Font.Height = -21 264 | Font.Name = 'Tahoma' 265 | Font.Style = [] 266 | ParentFont = False 267 | end 268 | object Label5: TLabel 269 | Left = 59 270 | Top = 30 271 | Width = 99 272 | Height = 16 273 | Caption = 'ReST API Demo' 274 | Font.Charset = DEFAULT_CHARSET 275 | Font.Color = 9961697 276 | Font.Height = -13 277 | Font.Name = 'Tahoma' 278 | Font.Style = [fsBold] 279 | ParentFont = False 280 | end 281 | end 282 | object IdHTTP1: TIdHTTP 283 | AllowCookies = True 284 | ProxyParams.BasicAuthentication = False 285 | ProxyParams.ProxyPort = 0 286 | Request.ContentLength = -1 287 | Request.ContentRangeEnd = -1 288 | Request.ContentRangeStart = -1 289 | Request.ContentRangeInstanceLength = -1 290 | Request.Accept = 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8' 291 | Request.BasicAuthentication = False 292 | Request.UserAgent = 'Mozilla/3.0 (compatible; Indy Library)' 293 | Request.Ranges.Units = 'bytes' 294 | Request.Ranges = <> 295 | HTTPOptions = [hoForceEncodeParams, hoNoParseMetaHTTPEquiv, hoNoProtocolErrorException, hoWantProtocolErrorContent] 296 | Left = 432 297 | Top = 59 298 | end 299 | end 300 | -------------------------------------------------------------------------------- /Demos/Proxy/Demo.Form.ProxyClient.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi GraphQL } 4 | { Copyright (c) 2022 Luca Minuti } 5 | { https://github.com/lminuti/graphql } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | unit Demo.Form.ProxyClient; 23 | 24 | interface 25 | 26 | uses 27 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 28 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Winapi.ShellAPI, Demo.ProxyServer, 29 | IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, 30 | Vcl.ExtCtrls, Vcl.Imaging.pngimage; 31 | 32 | type 33 | TMainProxyForm = class(TForm) 34 | SourceMemo: TMemo; 35 | RunQueryButton: TButton; 36 | ResultMemo: TMemo; 37 | Label1: TLabel; 38 | btnStart: TButton; 39 | btnStop: TButton; 40 | Label2: TLabel; 41 | edtPort: TEdit; 42 | IdHTTP1: TIdHTTP; 43 | memLog: TMemo; 44 | lblLink: TLabel; 45 | Label3: TLabel; 46 | Panel1: TPanel; 47 | Image1: TImage; 48 | Label4: TLabel; 49 | Label5: TLabel; 50 | procedure btnStartClick(Sender: TObject); 51 | procedure btnStopClick(Sender: TObject); 52 | procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); 53 | procedure lblLinkClick(Sender: TObject); 54 | procedure RunQueryButtonClick(Sender: TObject); 55 | private 56 | FProxyServer: TProxyServer; 57 | procedure HandleAsyncLog(ASender: TObject; const AMessage: string); 58 | public 59 | constructor Create(AOwner: TComponent); override; 60 | destructor Destroy; override; 61 | end; 62 | 63 | var 64 | MainProxyForm: TMainProxyForm; 65 | 66 | implementation 67 | 68 | {$R *.dfm} 69 | 70 | uses 71 | GraphQL.Utils.JSON, Demo.Form.Parameters; 72 | 73 | { TMainProxyForm } 74 | 75 | constructor TMainProxyForm.Create(AOwner: TComponent); 76 | begin 77 | inherited; 78 | FProxyServer := TProxyServer.Create; 79 | FProxyServer.OnAsyncLog := HandleAsyncLog; 80 | end; 81 | 82 | destructor TMainProxyForm.Destroy; 83 | begin 84 | FProxyServer.Free; 85 | inherited; 86 | end; 87 | 88 | procedure TMainProxyForm.btnStartClick(Sender: TObject); 89 | begin 90 | FProxyServer.Port := StrToIntDef(edtPort.Text, 8081); 91 | FProxyServer.Connect; 92 | end; 93 | 94 | procedure TMainProxyForm.btnStopClick(Sender: TObject); 95 | begin 96 | FProxyServer.Disconnect; 97 | end; 98 | 99 | procedure TMainProxyForm.FormKeyUp(Sender: TObject; var Key: Word; Shift: 100 | TShiftState); 101 | begin 102 | if Key = VK_F5 then 103 | RunQueryButton.Click; 104 | end; 105 | 106 | procedure TMainProxyForm.HandleAsyncLog(ASender: TObject; 107 | const AMessage: string); 108 | begin 109 | TThread.Queue(nil, procedure 110 | begin 111 | memLog.Lines.Add(AMessage); 112 | end); 113 | end; 114 | 115 | procedure TMainProxyForm.lblLinkClick(Sender: TObject); 116 | begin 117 | ShellExecute(Handle, 'open', PChar(lblLink.Caption), '', '', SW_NORMAL); 118 | end; 119 | 120 | procedure TMainProxyForm.RunQueryButtonClick(Sender: TObject); 121 | var 122 | LStringStream: TStringStream; 123 | LVariableJSON: string; 124 | begin 125 | if not FProxyServer.Active then 126 | begin 127 | btnStart.Click; 128 | end; 129 | 130 | memLog.Clear; 131 | 132 | LVariableJSON := TParametersForm.GetVariables(SourceMemo.Text); 133 | if LVariableJSON <> '' then 134 | LVariableJSON := ', "variables": ' + LVariableJSON; 135 | 136 | LStringStream := TStringStream.Create('{"query":' + TJSONHelper.QuoteString(SourceMemo.Text) + LVariableJSON + '}', TEncoding.UTF8); 137 | try 138 | ResultMemo.Text := TJSONHelper.PrettyPrint(IdHTTP1.Post('http://localhost:' + edtPort.Text, LStringStream)); 139 | finally 140 | LStringStream.Free; 141 | end; 142 | end; 143 | 144 | end. 145 | -------------------------------------------------------------------------------- /Demos/Proxy/Demo.ProxyServer.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi GraphQL } 4 | { Copyright (c) 2022 Luca Minuti } 5 | { https://github.com/lminuti/graphql } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | unit Demo.ProxyServer; 23 | 24 | interface 25 | 26 | uses 27 | System.Classes, System.SysUtils, System.Rtti, System.JSON, 28 | IdHttpServer, IdContext, IdCustomHTTPServer, IdHeaderList, 29 | GraphQL.Core, GraphQL.Resolver.Core, GraphQL.Query; 30 | 31 | type 32 | TAsyncLogEvent = procedure (ASender: TObject; const AMessage: string) of object; 33 | 34 | TProxyServer = class(TObject) 35 | private 36 | FPort: Integer; 37 | FHttpServer: TIdHTTPServer; 38 | FQuery: TGraphQLQuery; 39 | FOnAsyncLog: TAsyncLogEvent; 40 | 41 | procedure HandleCreatePostStream(AContext: TIdContext; AHeaders: TIdHeaderList; var VPostStream: TStream); 42 | procedure HandleCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); 43 | procedure HandleDoneWithPostStream(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; var VCanFree: Boolean); 44 | function JSONToVariable(AGraphQL: IGraphQL; const LJson: TJSONObject): IGraphQLVariables; 45 | function GetActive: Boolean; 46 | procedure SetActive(const Value: Boolean); 47 | 48 | function CreateResolver: IGraphQLResolver; 49 | procedure AsyncLog(const AMessage: string); 50 | function ErrorToJSON(E: Exception): string; 51 | public 52 | property Port: Integer read FPort write FPort; 53 | property Active: Boolean read GetActive write SetActive; 54 | property OnAsyncLog: TAsyncLogEvent read FOnAsyncLog write FOnAsyncLog; 55 | 56 | procedure Connect; 57 | procedure Disconnect; 58 | 59 | constructor Create; 60 | destructor Destroy; override; 61 | end; 62 | 63 | implementation 64 | 65 | { TProxyServer } 66 | 67 | uses 68 | GraphQL.Resolver.ReST, GraphQL.Lexer.Core; 69 | 70 | procedure TProxyServer.AsyncLog(const AMessage: string); 71 | var 72 | LMessage: string; 73 | begin 74 | if Assigned(FOnAsyncLog) then 75 | begin 76 | 77 | LMessage := StringReplace(AMessage, #13, '', [rfReplaceAll]); 78 | LMessage := StringReplace(LMessage, #10, '', [rfReplaceAll]); 79 | LMessage := Copy(LMessage, 1, 200); 80 | 81 | FOnAsyncLog(Self, LMessage); 82 | end; 83 | end; 84 | 85 | procedure TProxyServer.Connect; 86 | begin 87 | FHttpServer.DefaultPort := FPort; 88 | FHttpServer.Active := True; 89 | end; 90 | 91 | constructor TProxyServer.Create; 92 | begin 93 | FHttpServer := TIdHTTPServer.Create(nil); 94 | FHttpServer.OnCommandGet := HandleCommandGet; 95 | FHttpServer.OnCreatePostStream := HandleCreatePostStream; 96 | FHttpServer.OnDoneWithPostStream := HandleDoneWithPostStream; 97 | 98 | FQuery := TGraphQLQuery.Create; 99 | FQuery.RegisterResolver(CreateResolver); 100 | end; 101 | 102 | function TProxyServer.CreateResolver: IGraphQLResolver; 103 | var 104 | LResolver: TGraphQLReSTResolver; 105 | begin 106 | LResolver := TGraphQLReSTResolver.Create; 107 | 108 | LResolver.MapEntity('posts', 'https://jsonplaceholder.typicode.com/posts/{id}'); 109 | LResolver.MapEntity('comments', 'https://jsonplaceholder.typicode.com/comments/{id}'); 110 | LResolver.MapEntity('albums', 'https://jsonplaceholder.typicode.com/albums/{id}'); 111 | LResolver.MapEntity('todos', 'https://jsonplaceholder.typicode.com/todos/{id}'); 112 | LResolver.MapEntity('users', 'https://jsonplaceholder.typicode.com/users/{id}'); 113 | LResolver.MapEntity('users/posts', 'https://jsonplaceholder.typicode.com/users/{parentId}/posts'); 114 | LResolver.MapEntity('users/comments', 'https://jsonplaceholder.typicode.com/users/{parentId}/comments'); 115 | LResolver.MapEntity('users/todos', 'https://jsonplaceholder.typicode.com/users/{parentId}/todos'); 116 | 117 | Result := LResolver; 118 | end; 119 | 120 | destructor TProxyServer.Destroy; 121 | begin 122 | FQuery.Free; 123 | FHttpServer.Free; 124 | inherited; 125 | end; 126 | 127 | procedure TProxyServer.Disconnect; 128 | begin 129 | FHttpServer.Active := False; 130 | end; 131 | 132 | function TProxyServer.GetActive: Boolean; 133 | begin 134 | Result := FHttpServer.Active; 135 | end; 136 | 137 | function TProxyServer.ErrorToJSON(E: Exception): string; 138 | var 139 | LJSONError, LJSONErrorItem, LJSONPosition: TJSONObject; 140 | LJSONErrors: TJSONArray; 141 | begin 142 | LJSONError := TJSONObject.Create; 143 | try 144 | LJSONErrorItem := TJSONObject.Create; 145 | LJSONErrorItem.AddPair('message', E.Message); 146 | 147 | if E is EScannerError then 148 | begin 149 | LJSONPosition := TJSONObject.Create; 150 | LJSONPosition.AddPair('line', TJSONNumber.Create(EScannerError(E).Line)); 151 | LJSONPosition.AddPair('column', TJSONNumber.Create(EScannerError(E).Col)); 152 | LJSONErrorItem.AddPair('locations', LJSONPosition); 153 | end; 154 | 155 | LJSONErrors := TJSONArray.Create; 156 | LJSONErrors.AddElement(LJSONErrorItem); 157 | LJSONError.AddPair('errors', LJSONErrors); 158 | 159 | Result := LJSONError.ToJSON; 160 | finally 161 | LJSONError.Free; 162 | end; 163 | end; 164 | 165 | procedure TProxyServer.HandleCommandGet(AContext: TIdContext; 166 | ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); 167 | var 168 | LRequestContent: UTF8String; 169 | LPostStream: TStream; 170 | LJSONValue: TJSONValue; 171 | LQuery: string; 172 | LVariables: TJSONObject; 173 | LGraphQLVariable: IGraphQLVariables; 174 | LGraphQL: IGraphQL; 175 | begin 176 | LPostStream := TStream(AContext.Data); 177 | try 178 | 179 | AResponseInfo.ContentType := 'application/json'; 180 | try 181 | LRequestContent := ''; 182 | if LPostStream.Size > 0 then 183 | begin 184 | LPostStream.Position := 0; 185 | SetLength(LRequestContent, LPostStream.Size); 186 | LPostStream.Read(LRequestContent[1], LPostStream.Size); 187 | end; 188 | LJSONValue := TJSONObject.ParseJSONValue(LRequestContent); 189 | try 190 | if not Assigned(LJSONValue) or (not (LJSONValue is TJSONObject)) then 191 | raise Exception.Create('Invalid request'); 192 | 193 | LQuery := TJSONObject(LJSONValue).GetValue('query'); 194 | if not TJSONObject(LJSONValue).TryGetValue('variables', LVariables) then 195 | LVariables := nil; 196 | 197 | LGraphQL := FQuery.Parse(LQuery); 198 | LGraphQLVariable := JSONToVariable(LGraphQL, LVariables); 199 | AsyncLog('Request: ' + ARequestInfo.Command + ' ' + ARequestInfo.Document + ' body>>> ' + LQuery); 200 | AResponseInfo.ContentText := 201 | FQuery.Run(LGraphQL, LGraphQLVariable); 202 | finally 203 | LJSONValue.Free; 204 | end; 205 | except 206 | on E: Exception do 207 | begin 208 | AResponseInfo.ResponseNo := 500; 209 | AResponseInfo.ContentText := ErrorToJSON(E); 210 | end; 211 | end; 212 | 213 | finally 214 | LPostStream.Free; 215 | AContext.Data := nil; 216 | end; 217 | AsyncLog('Response: ' + AResponseInfo.ResponseNo.ToString + ' ' + AResponseInfo.ResponseText + ' body>>> ' + AResponseInfo.ContentText); 218 | end; 219 | 220 | procedure TProxyServer.HandleCreatePostStream(AContext: TIdContext; 221 | AHeaders: TIdHeaderList; var VPostStream: TStream); 222 | begin 223 | VPostStream := TMemoryStream.Create; 224 | AContext.Data := VPostStream; 225 | end; 226 | 227 | procedure TProxyServer.HandleDoneWithPostStream(AContext: TIdContext; 228 | ARequestInfo: TIdHTTPRequestInfo; var VCanFree: Boolean); 229 | begin 230 | VCanFree := False; 231 | end; 232 | 233 | function TProxyServer.JSONToVariable(AGraphQL: IGraphQL; const LJson: TJSONObject): IGraphQLVariables; 234 | var 235 | LParam: IGraphQLParam; 236 | begin 237 | Result := TGraphQLVariables.Create; 238 | for LParam in AGraphQL.Params do 239 | begin 240 | case LParam.ParamType of 241 | TGraphQLVariableType.StringType: Result.SetVariable(LParam.ParamName, LJson.GetValue(LParam.ParamName)); 242 | TGraphQLVariableType.IntType: Result.SetVariable(LParam.ParamName, LJson.GetValue(LParam.ParamName)); 243 | TGraphQLVariableType.FloatType: Result.SetVariable(LParam.ParamName, LJson.GetValue(LParam.ParamName)); 244 | TGraphQLVariableType.BooleanType: Result.SetVariable(LParam.ParamName, LJson.GetValue(LParam.ParamName)); 245 | TGraphQLVariableType.IdType: Result.SetVariable(LParam.ParamName, LJson.GetValue(LParam.ParamName)); 246 | else 247 | raise Exception.Create('Parameters type unknown'); 248 | end; 249 | end; 250 | end; 251 | 252 | procedure TProxyServer.SetActive(const Value: Boolean); 253 | begin 254 | if Value then 255 | Connect 256 | else 257 | Disconnect; 258 | end; 259 | 260 | end. 261 | -------------------------------------------------------------------------------- /Demos/Proxy/ProxyDemo.dpr: -------------------------------------------------------------------------------- 1 | program ProxyDemo; 2 | 3 | uses 4 | Vcl.Forms, 5 | Demo.Form.ProxyClient in 'Demo.Form.ProxyClient.pas' {MainProxyForm}, 6 | Demo.ProxyServer in 'Demo.ProxyServer.pas', 7 | GraphQL.Query in '..\..\Source\GraphQL.Query.pas', 8 | GraphQL.Core in '..\..\Source\GraphQL.Core.pas', 9 | GraphQL.Resolver.Core in '..\..\Source\GraphQL.Resolver.Core.pas', 10 | GraphQL.Lexer.Core in '..\..\Source\GraphQL.Lexer.Core.pas', 11 | GraphQL.Utils.JSON in '..\..\Source\GraphQL.Utils.JSON.pas', 12 | GraphQL.Utils.Rtti in '..\..\Source\GraphQL.Utils.Rtti.pas', 13 | GraphQL.Classes in '..\..\Source\GraphQL.Classes.pas', 14 | GraphQL.SyntaxAnalysis.Core in '..\..\Source\GraphQL.SyntaxAnalysis.Core.pas', 15 | GraphQL.Resolver.ReST in '..\..\Source\GraphQL.Resolver.ReST.pas', 16 | Demo.Form.Parameters in 'Demo.Form.Parameters.pas' {ParametersForm}, 17 | GraphQL.SyntaxAnalysis.Builder in '..\..\Source\GraphQL.SyntaxAnalysis.Builder.pas'; 18 | 19 | {$R *.res} 20 | 21 | begin 22 | ReportMemoryLeaksOnShutdown := True; 23 | Application.Initialize; 24 | Application.MainFormOnTaskbar := True; 25 | Application.CreateForm(TMainProxyForm, MainProxyForm); 26 | Application.Run; 27 | end. 28 | -------------------------------------------------------------------------------- /Demos/Proxy/ProxyDemo.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lminuti/graphql/4eeb388880f8abfd5faccc92a1783191de077a7a/Demos/Proxy/ProxyDemo.res -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "[]" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright [yyyy] [name of copyright owner] 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # GraphQL for Delphi 2 | 3 | [![License](https://img.shields.io/badge/License-Apache%202.0-yellowgreen.svg)](https://opensource.org/licenses/Apache-2.0) 4 | 5 | Simple implementation for GraphQL, a query language for APIs created by Facebook. 6 | 7 | GraphQL is a query language for your API and a server-side runtime for executing queries using a type system you define for your data. GraphQL isn't tied to any specific database or storage engine and is instead backed by your existing code and data. 8 | 9 | See more complete documentation at https://graphql.org/. 10 | 11 | ## Table of Contents 12 | 13 | - [Features](#features) 14 | - [GraphQL tree navigation](#graphql-tree-navigation) 15 | - [Query your API with GraphQL](#query-your-api-with-graphql) 16 | - [Basic API](#basic-api) 17 | - [Run methods from a class using RTTI](#run-methods-from-a-class-using-rtti) 18 | - [Use API from a ReST server](#use-api-from-a-rest-server) 19 | - [Todo](#todo) 20 | 21 | 22 | 23 | ## Features 24 | 25 | *GraphQL for Delphi* supports only a basic part of the [GraphQL specifications](https://spec.graphql.org/draft/): 26 | 27 | * Fields 28 | * Arguments 29 | * Aliases 30 | 31 | Other parts like *variables*, *schema* and *validation* are under development. 32 | 33 | ### GraphQL tree navigation 34 | 35 | The more basic feature of *GraphQL for Delphi* is the possibility to explore the GraphQL query. 36 | 37 | With a code like this you can build the GraphQL tree: 38 | 39 | ```pascal 40 | LBuilder := TGraphQLBuilder.Create(SourceMemo.Text); 41 | try 42 | // This will create the tree 43 | LGraphQL := LBuilder.Build; 44 | finally 45 | LBuilder.Free; 46 | end; 47 | ``` 48 | 49 | Then you will have a struture like this: 50 | 51 | ``` 52 | IGraphQL 53 | ├── Name 54 | └── Fields 55 | ├── IGraphQLField (first entity) 56 | │ ├── Name 57 | │ ├── Alias 58 | │ ├── Arguments / Parameters 59 | │ │ ├─ IGraphQLArgument 60 | │ │ └─ IGraphQLArgument 61 | │ │ 62 | │ └── IGraphQLValue (IGraphQLNull | IGraphQLObject) 63 | │ └─ Fields 64 | │ ├─ ... 65 | │ ├─ ... 66 | │ 67 | └── IGraphQLField (second entity) 68 | ├── Name 69 | ├── Alias 70 | ├── ... 71 | ``` 72 | 73 | You can see the demo to have an idea of the capabilities of this library. 74 | 75 | ![](https://raw.githubusercontent.com/wiki/lminuti/graphql/demo1.png) 76 | 77 | ### Query your API with GraphQL 78 | 79 | First of all you need an `API` to query. At this moment *GraphQL for Delphi* supports `classes` or simple `procedures and functions`. In either case you have to tell the library how to call your API. 80 | 81 | #### Basic API 82 | 83 | If you have a simple API made of classic functions like this: 84 | 85 | ```pascal 86 | function RollDice(NumDices, NumSides: Integer): Integer; 87 | 88 | function ReverseString(const Value: string): string; 89 | 90 | function StarWarsHero(const Id: string): TStarWarsHero; 91 | ``` 92 | 93 | Then you need to register your API in this way: 94 | 95 | ```pascal 96 | FQuery := TGraphQLQuery.Create; 97 | 98 | FQuery.RegisterFunction('rollDice', 99 | function (AParams: TGraphQLParams) :TValue 100 | begin 101 | Result := RollDice(AParams.Get('numDice').AsInteger, AParams.Get('numSides').AsInteger); 102 | end 103 | ); 104 | 105 | FQuery.RegisterFunction('reverseString', 106 | function (AParams: TGraphQLParams) :TValue 107 | begin 108 | Result := ReverseString(AParams.Get('value').AsString); 109 | end 110 | ); 111 | 112 | FQuery.RegisterFunction('hero', 113 | function (AParams: TGraphQLParams) :TValue 114 | begin 115 | Result := StarWarsHero(AParams.Get('id').AsString); 116 | end 117 | ); 118 | ``` 119 | 120 | Eventually you can query your API: 121 | 122 | ```pascal 123 | 124 | json := FQuery.Run(MyQuery); 125 | 126 | ``` 127 | 128 | #### Run methods from a class using RTTI 129 | 130 | If you have a class you need to tell the library: 131 | 132 | * how to create the instance; 133 | * if the class is a *singleton* (or if the library should create a new instance for every method call); 134 | * which methods GraphQL should query. 135 | 136 | For example if you have a class like this: 137 | 138 | ```pascal 139 | TTestApi = class(TObject) 140 | private 141 | FCounter: Integer; 142 | public 143 | [GraphQLEntity] 144 | function Sum(a, b: Integer): Integer; 145 | 146 | [GraphQLEntity('mainHero')] 147 | function MainHero: TStarWarsHero; 148 | 149 | end; 150 | ``` 151 | 152 | You need to add the `GraphQLEntity` to every method queryable by GraphQL and register the class: 153 | 154 | ```pascal 155 | FQuery := TGraphQLQuery.Create; 156 | FQuery.RegisterResolver(TGraphQLRttiResolver.Create(TTestApi, True)); 157 | ``` 158 | 159 | The `RegisterResolver` method can add a resolver (any class that implements `IGraphQLResolver`) to the GraphQL engine. A resolver is a simple object that explains to GraphQL how to get the data from the API. You can build your own resolvers or use the resolvers build-in with the library. 160 | 161 | The `TGraphQLRttiResolver` is capable of running methods from a class using the [RTTI](https://docwiki.embarcadero.com/RADStudio/Sydney/en/Working_with_RTTI). 162 | 163 | Then you can query your API: 164 | 165 | ```pascal 166 | 167 | json := FQuery.Run(MyQuery); 168 | 169 | ``` 170 | 171 | A simple query: 172 | 173 | ![](https://raw.githubusercontent.com/wiki/lminuti/graphql/GraphQL-Basic.gif) 174 | 175 | How to use GraphQL aliases: 176 | 177 | ![](https://raw.githubusercontent.com/wiki/lminuti/graphql/GraphQL-Alias.gif) 178 | 179 | How to call simple functions: 180 | 181 | ![](https://raw.githubusercontent.com/wiki/lminuti/graphql/GraphQL-RollDice.gif) 182 | 183 | A more complex example: 184 | 185 | ![](https://raw.githubusercontent.com/wiki/lminuti/graphql/GraphQL-complex.gif) 186 | 187 | 188 | ### Use API from a ReST server 189 | 190 | If you need to use GraphQL to queries a ReST API you can see the `ProxyDemo`. This simple project creates a basic HTTP server that responds to GraphQL query and uses a remote ReST API (https://jsonplaceholder.typicode.com/) as a data source. 191 | 192 | The project uses a `TGraphQLReSTResolver` to map the GraphQL fields to the ReST API in this way: 193 | 194 | ```pascal 195 | FQuery := TGraphQLQuery.Create; 196 | 197 | LResolver := TGraphQLReSTResolver.Create; 198 | 199 | // Basic entities 200 | LResolver.MapEntity('posts', 'https://jsonplaceholder.typicode.com/posts/{id}'); 201 | LResolver.MapEntity('comments', 'https://jsonplaceholder.typicode.com/comments/{id}'); 202 | LResolver.MapEntity('albums', 'https://jsonplaceholder.typicode.com/albums/{id}'); 203 | LResolver.MapEntity('todos', 'https://jsonplaceholder.typicode.com/todos/{id}'); 204 | LResolver.MapEntity('users', 'https://jsonplaceholder.typicode.com/users/{id}'); 205 | 206 | // Entity details 207 | LResolver.MapEntity('users/posts', 'https://jsonplaceholder.typicode.com/users/{parentId}/posts'); 208 | LResolver.MapEntity('users/comments', 'https://jsonplaceholder.typicode.com/users/{parentId}/comments'); 209 | LResolver.MapEntity('users/todos', 'https://jsonplaceholder.typicode.com/users/{parentId}/todos'); 210 | 211 | FQuery.RegisterResolver(LResolver); 212 | 213 | ``` 214 | 215 | When you define an `entity` you can specify the name of the `id property` (default "id"). The id propery will be used if your entity as a detail. For example you have a resource like: 216 | 217 | ```url 218 | https://jsonplaceholder.typicode.com/users/1 219 | ``` 220 | 221 | ```json 222 | { 223 | "userId": 1, 224 | "name": "Luca" 225 | } 226 | ``` 227 | 228 | and a detail resource like: 229 | 230 | ```url 231 | https://jsonplaceholder.typicode.com/users/1/todos 232 | ``` 233 | 234 | ```json 235 | [{ 236 | "id": 1, 237 | "userId": 1, 238 | "title": "Something to do" 239 | },{ 240 | "id": 2, 241 | "userId": 1, 242 | "title": "Another thing to do" 243 | }] 244 | ``` 245 | 246 | You must define the entities in this way: 247 | 248 | ```pascal 249 | LResolver.MapEntity('users', 'https://jsonplaceholder.typicode.com/users/{id}', 'userId'); 250 | LResolver.MapEntity('users/todos', 'https://jsonplaceholder.typicode.com/users/{parentId}/todos'); 251 | ``` 252 | 253 | Then, when you run the query with `FQuery.Run(...)`, the resolver can call the right ReST API. 254 | 255 | ![](https://raw.githubusercontent.com/wiki/lminuti/graphql/demo4.png) 256 | 257 | ## Todo 258 | 259 | * :fire: `Variables`. GraphQL has a first-class way to factor dynamic values out of the query, and pass them as a separate dictionary. These values are called variables. 260 | * :fire: `Schemas`, `types` and `validation`. Every GraphQL service defines a set of types which completely describe the set of possible data you can query on that service. Then, when queries come in, they are validated and executed against that schema. 261 | * :thumbsup: `Fragments`. Fragments let you construct sets of fields, and then include them in queries where you need to. 262 | * :question: `Directives`. A directive can be attached to a field or fragment inclusion, and can affect execution of the query in any way the server desires. 263 | * :question: `Mutations`. Just like ReST any query can might end up causing some side-effects. However, it's useful to establish a convention that any operations that cause writes should be sent explicitly via a mutation. 264 | -------------------------------------------------------------------------------- /Source/GraphQL.Classes.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi GraphQL } 4 | { Copyright (c) 2022 Luca Minuti } 5 | { https://github.com/lminuti/graphql } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | unit GraphQL.Classes; 23 | 24 | interface 25 | 26 | uses 27 | System.Classes, System.SysUtils, System.Rtti, Generics.Collections, 28 | GraphQL.Core; 29 | 30 | type 31 | IEditableList = interface 32 | ['{E88973EB-46E0-4CF5-8DEE-A86CA4F095F7}'] 33 | procedure Add(AItem: T); 34 | end; 35 | 36 | TInterfacedList = class(TInterfacedObject, IGraphQLList, IEditableList) 37 | private 38 | FItems: TList; 39 | public 40 | function Count: Integer; 41 | function GetItem(LIndex: Integer): T; 42 | function GetEnumerator: TEnumerator; 43 | property Items[LIndex: Integer]: T read GetItem; 44 | procedure Add(AItem: T); 45 | 46 | constructor Create; 47 | destructor Destroy; override; 48 | end; 49 | 50 | TGraphQLArgument = class(TInterfacedObject, IGraphQLArgument) 51 | private 52 | FName: string; 53 | FArgumentType: TGraphQLVariableType; 54 | FAttributes: TGraphQLArgumentAttributes; 55 | FValue: TValue; 56 | public 57 | { IGraphQLArgument } 58 | function GetName: string; 59 | function GetArgumentType: TGraphQLVariableType; 60 | function GetAttributes: TGraphQLArgumentAttributes; 61 | function GetValue: TValue; 62 | function GetSubArguments: IGraphQLArgument; 63 | 64 | constructor Create(const AName: string; AArgumentType: TGraphQLVariableType; AAttributes: TGraphQLArgumentAttributes; AValue: TValue); 65 | end; 66 | 67 | TGraphQLArguments = class(TInterfacedList) 68 | end; 69 | 70 | TGraphQLObject = class(TInterfacedObject, IGraphQLObject, IGraphQLValue) 71 | private 72 | FFields: IGraphQLList; 73 | public 74 | { IGraphQLObject } 75 | procedure Add(AField: IGraphQLField); 76 | function FieldCount: Integer; 77 | function GetFields: IGraphQLList; 78 | function GetFieldByName(const AName: string): IGraphQLField; 79 | function FindFieldByName(const AName: string): IGraphQLField; 80 | 81 | constructor Create; 82 | destructor Destroy; override; 83 | end; 84 | 85 | TGraphQLNull = class(TInterfacedObject, IGraphQLNull, IGraphQLValue) 86 | 87 | end; 88 | 89 | TGraphQLField = class(TInterfacedObject, IGraphQLField) 90 | private 91 | FFieldName: string; 92 | FFieldAlias: string; 93 | FValue: IGraphQLValue; 94 | FArguments: IGraphQLList; 95 | [unsafe] 96 | FParentField: IGraphQLField; 97 | public 98 | { IGraphQLField } 99 | function GetFieldName: string; 100 | function GetFieldAlias: string; 101 | function GetValue: IGraphQLValue; 102 | function GetArguments: IGraphQLList; 103 | function ArgumentCount: Integer; 104 | function ArgumentByName(const AName: string): IGraphQLArgument; 105 | function GetParentField: IGraphQLField; 106 | 107 | procedure SetValue(AValue: IGraphQLValue); 108 | 109 | constructor Create(AParentField: IGraphQLField; const AFieldName, AFieldAlias: string; AArguments: IGraphQLList); 110 | destructor Destroy; override; 111 | end; 112 | 113 | TGraphQLParam = class(TInterfacedObject, IGraphQLParam) 114 | private 115 | FParamName: string; 116 | FParamType: TGraphQLVariableType; 117 | FRequired: Boolean; 118 | FDefaultValue: TValue; 119 | public 120 | { IGraphQLParam } 121 | function GetParamName: string; 122 | procedure SetParamName(const LValue: string); 123 | function GetParamType: TGraphQLVariableType; 124 | procedure SetParamType(LValue: TGraphQLVariableType); 125 | function GetRequired: Boolean; 126 | procedure SetRequired(LValue: Boolean); 127 | function GetDefaultValue: TValue; 128 | procedure SetDefaultValue(LValue: TValue); 129 | 130 | constructor Create(const AParamName: string; AParamType: TGraphQLVariableType; ARequired: Boolean; ADefaultValue: TValue); 131 | end; 132 | 133 | TGraphQL = class(TInterfacedObject, IGraphQL) 134 | private 135 | FName: string; 136 | FFields: IGraphQLList; 137 | FParams: IGraphQLList; 138 | public 139 | { IGraphQL } 140 | function GetName: string; 141 | procedure SetName(const AName: string); 142 | procedure AddField(AField: IGraphQLField); 143 | function FieldCount: Integer; 144 | function GetFields: IGraphQLList; 145 | function ParamByName(const AName: string): IGraphQLParam; 146 | function FieldByName(const AName: string): IGraphQLField; 147 | 148 | function GetParams: IGraphQLList; 149 | procedure AddParam(AParam: IGraphQLParam); 150 | function ParamCount: Integer; 151 | 152 | constructor Create; 153 | destructor Destroy; override; 154 | end; 155 | 156 | implementation 157 | 158 | { TGraphQL } 159 | 160 | procedure TGraphQL.AddField(AField: IGraphQLField); 161 | begin 162 | (FFields as IEditableList).Add(AField); 163 | end; 164 | 165 | procedure TGraphQL.AddParam(AParam: IGraphQLParam); 166 | begin 167 | (FParams as IEditableList).Add(AParam); 168 | end; 169 | 170 | constructor TGraphQL.Create; 171 | begin 172 | FFields := TInterfacedList.Create(); 173 | FParams := TInterfacedList.Create(); 174 | end; 175 | 176 | destructor TGraphQL.Destroy; 177 | begin 178 | //FFields.Free; 179 | inherited; 180 | end; 181 | 182 | function TGraphQL.FieldByName(const AName: string): IGraphQLField; 183 | var 184 | LField: IGraphQLField; 185 | begin 186 | Result := nil; 187 | for LField in FFields do 188 | if LField.FieldName = AName then 189 | Exit(LField); 190 | 191 | raise EGraphQLFieldNotFound.CreateFmt('Field [%s] not found', [AName]); 192 | end; 193 | 194 | function TGraphQL.FieldCount: Integer; 195 | begin 196 | Result := FFields.Count; 197 | end; 198 | 199 | function TGraphQL.GetFields: IGraphQLList; 200 | begin 201 | Result := FFields; 202 | end; 203 | 204 | function TGraphQL.GetName: string; 205 | begin 206 | Result := FName; 207 | end; 208 | 209 | function TGraphQL.GetParams: IGraphQLList; 210 | begin 211 | Result := FParams; 212 | end; 213 | 214 | function TGraphQL.ParamByName(const AName: string): IGraphQLParam; 215 | var 216 | LParam: IGraphQLParam; 217 | begin 218 | Result := nil; 219 | for LParam in FParams do 220 | if LParam.ParamName = AName then 221 | Exit(LParam); 222 | 223 | raise EGraphQLParameterNotFound.CreateFmt('Parameter [%s] not found', [AName]); 224 | end; 225 | 226 | function TGraphQL.ParamCount: Integer; 227 | begin 228 | Result := FParams.Count; 229 | end; 230 | 231 | procedure TGraphQL.SetName(const AName: string); 232 | begin 233 | FName := AName; 234 | end; 235 | 236 | { TGraphQLField } 237 | 238 | function TGraphQLField.ArgumentByName(const AName: string): IGraphQLArgument; 239 | var 240 | LIndex: Integer; 241 | begin 242 | for LIndex := 0 to FArguments.Count - 1 do 243 | begin 244 | if FArguments[LIndex].Name = AName then 245 | Exit(FArguments[LIndex]); 246 | end; 247 | raise EGraphQLArgumentNotFound.CreateFmt('Argument [%s] not found', [AName]); 248 | end; 249 | 250 | function TGraphQLField.ArgumentCount: Integer; 251 | begin 252 | Result := FArguments.Count; 253 | end; 254 | 255 | constructor TGraphQLField.Create(AParentField: IGraphQLField; const AFieldName, AFieldAlias: string; AArguments: IGraphQLList); 256 | begin 257 | inherited Create; 258 | if Assigned(AArguments) then 259 | FArguments := AArguments 260 | else 261 | FArguments := TInterfacedList.Create; 262 | FFieldName := AFieldName; 263 | FFieldAlias := AFieldAlias; 264 | FParentField := AParentField; 265 | end; 266 | 267 | destructor TGraphQLField.Destroy; 268 | begin 269 | inherited; 270 | end; 271 | 272 | function TGraphQLField.GetArguments: IGraphQLList; 273 | begin 274 | Result := FArguments; 275 | end; 276 | 277 | function TGraphQLField.GetFieldAlias: string; 278 | begin 279 | Result := FFieldAlias; 280 | end; 281 | 282 | function TGraphQLField.GetFieldName: string; 283 | begin 284 | Result := FFieldName; 285 | end; 286 | 287 | function TGraphQLField.GetParentField: IGraphQLField; 288 | begin 289 | Result := FParentField; 290 | end; 291 | 292 | function TGraphQLField.GetValue: IGraphQLValue; 293 | begin 294 | Result := FValue; 295 | end; 296 | 297 | procedure TGraphQLField.SetValue(AValue: IGraphQLValue); 298 | begin 299 | FValue := AValue; 300 | end; 301 | 302 | { TGraphQLObject } 303 | 304 | procedure TGraphQLObject.Add(AField: IGraphQLField); 305 | begin 306 | (FFields as IEditableList).Add(AField); 307 | end; 308 | 309 | constructor TGraphQLObject.Create; 310 | begin 311 | FFields := TInterfacedList.Create; 312 | end; 313 | 314 | destructor TGraphQLObject.Destroy; 315 | begin 316 | inherited; 317 | end; 318 | 319 | function TGraphQLObject.FieldCount: Integer; 320 | begin 321 | Result := FFields.Count; 322 | end; 323 | 324 | function TGraphQLObject.FindFieldByName(const AName: string): IGraphQLField; 325 | var 326 | LIndex: Integer; 327 | begin 328 | Result := nil; 329 | for LIndex := 0 to FFields.Count - 1 do 330 | begin 331 | if FFields[LIndex].FieldName = AName then 332 | Result := FFields[LIndex]; 333 | end; 334 | end; 335 | 336 | function TGraphQLObject.GetFields: IGraphQLList; 337 | begin 338 | Result := FFields; 339 | end; 340 | 341 | function TGraphQLObject.GetFieldByName(const AName: string): IGraphQLField; 342 | begin 343 | Result := FindFieldByName(AName); 344 | if not Assigned(Result) then 345 | raise EGraphQLFieldNotFound.CreateFmt('Field [%s] not found', [AName]); 346 | end; 347 | 348 | { TGraphQLArgument } 349 | 350 | constructor TGraphQLArgument.Create(const AName: string; AArgumentType: TGraphQLVariableType; AAttributes: TGraphQLArgumentAttributes; AValue: TValue); 351 | begin 352 | inherited Create; 353 | FName := AName; 354 | FArgumentType := AArgumentType; 355 | FAttributes := AAttributes; 356 | FValue := AValue; 357 | end; 358 | 359 | function TGraphQLArgument.GetArgumentType: TGraphQLVariableType; 360 | begin 361 | Result := FArgumentType; 362 | end; 363 | 364 | function TGraphQLArgument.GetAttributes: TGraphQLArgumentAttributes; 365 | begin 366 | Result := FAttributes; 367 | end; 368 | 369 | function TGraphQLArgument.GetName: string; 370 | begin 371 | Result := FName; 372 | end; 373 | 374 | function TGraphQLArgument.GetSubArguments: IGraphQLArgument; 375 | begin 376 | raise Exception.Create('Error Message'); 377 | end; 378 | 379 | function TGraphQLArgument.GetValue: TValue; 380 | begin 381 | Result := FValue; 382 | end; 383 | 384 | { TInterfacedList } 385 | 386 | procedure TInterfacedList.Add(AItem: T); 387 | begin 388 | FItems.Add(AItem); 389 | end; 390 | 391 | function TInterfacedList.Count: Integer; 392 | begin 393 | Result := FItems.Count; 394 | end; 395 | 396 | constructor TInterfacedList.Create; 397 | begin 398 | inherited Create; 399 | FItems := TList.Create; 400 | end; 401 | 402 | destructor TInterfacedList.Destroy; 403 | begin 404 | inherited; 405 | FItems.Free; 406 | end; 407 | 408 | function TInterfacedList.GetEnumerator: TEnumerator; 409 | begin 410 | Result := FItems.GetEnumerator; 411 | end; 412 | 413 | function TInterfacedList.GetItem(LIndex: Integer): T; 414 | begin 415 | Result := FItems[LIndex]; 416 | end; 417 | 418 | { TGraphQLParam } 419 | 420 | constructor TGraphQLParam.Create(const AParamName: string; 421 | AParamType: TGraphQLVariableType; ARequired: Boolean; ADefaultValue: TValue); 422 | begin 423 | inherited Create; 424 | FParamName := AParamName; 425 | FParamType := AParamType; 426 | FRequired := ARequired; 427 | FDefaultValue := ADefaultValue; 428 | end; 429 | 430 | function TGraphQLParam.GetDefaultValue: TValue; 431 | begin 432 | Result := FDefaultValue; 433 | end; 434 | 435 | function TGraphQLParam.GetParamName: string; 436 | begin 437 | Result := FParamName; 438 | end; 439 | 440 | function TGraphQLParam.GetParamType: TGraphQLVariableType; 441 | begin 442 | Result := FParamType; 443 | end; 444 | 445 | function TGraphQLParam.GetRequired: Boolean; 446 | begin 447 | Result := FRequired; 448 | end; 449 | 450 | procedure TGraphQLParam.SetDefaultValue(LValue: TValue); 451 | begin 452 | FDefaultValue := LValue; 453 | end; 454 | 455 | procedure TGraphQLParam.SetParamName(const LValue: string); 456 | begin 457 | FParamName := LValue; 458 | end; 459 | 460 | procedure TGraphQLParam.SetParamType(LValue: TGraphQLVariableType); 461 | begin 462 | FParamType := LValue; 463 | end; 464 | 465 | procedure TGraphQLParam.SetRequired(LValue: Boolean); 466 | begin 467 | FRequired := LValue; 468 | end; 469 | 470 | end. 471 | -------------------------------------------------------------------------------- /Source/GraphQL.Core.Attributes.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi GraphQL } 4 | { Copyright (c) 2022 Luca Minuti } 5 | { https://github.com/lminuti/graphql } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | unit GraphQL.Core.Attributes; 23 | 24 | interface 25 | 26 | uses 27 | System.Classes, System.SysUtils, System.Rtti; 28 | 29 | type 30 | GraphQLEntityAttribute = class(TCustomAttribute) 31 | private 32 | FValue: string; 33 | public 34 | constructor Create(const AValue: string = ''); 35 | property Value: string read FValue write FValue; 36 | end; 37 | 38 | implementation 39 | 40 | { GraphQLEntityAttribute } 41 | 42 | constructor GraphQLEntityAttribute.Create(const AValue: string); 43 | begin 44 | inherited Create; 45 | FValue := AValue; 46 | end; 47 | 48 | end. 49 | -------------------------------------------------------------------------------- /Source/GraphQL.Core.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi GraphQL } 4 | { Copyright (c) 2022 Luca Minuti } 5 | { https://github.com/lminuti/graphql } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | unit GraphQL.Core; 23 | 24 | interface 25 | 26 | uses 27 | System.Classes, System.SysUtils, System.Rtti, Generics.Collections; 28 | 29 | type 30 | EGraphQLError = class(Exception) 31 | end; 32 | 33 | EGraphQLArgumentNotFound = class(EGraphQLError) 34 | end; 35 | 36 | EGraphQLParameterNotFound = class(EGraphQLError) 37 | end; 38 | 39 | EGraphQLFieldNotFound = class(EGraphQLError) 40 | end; 41 | 42 | {$SCOPEDENUMS ON} 43 | TGraphQLVariableType = ( 44 | UnknownType, 45 | StringType, 46 | IntType, 47 | FloatType, 48 | BooleanType, 49 | IdType, 50 | ObjectType, 51 | ArrayType 52 | ); 53 | 54 | TGraphQLArgumentAttribute = (Variable); 55 | 56 | TGraphQLArgumentAttributes = set of TGraphQLArgumentAttribute; 57 | {$SCOPEDENUMS OFF} 58 | 59 | IGraphQLList = interface 60 | ['{909FA6AE-FD7D-436D-B948-F11F2A5ECBCE}'] 61 | function Count: Integer; 62 | function GetItem(LIndex: Integer): T; 63 | function GetEnumerator: TEnumerator; 64 | property Items[LIndex: Integer]: T read GetItem; default; 65 | end; 66 | 67 | // abstact 68 | IGraphQLValue = interface 69 | ['{0471DB6A-6810-4C29-8276-BCB2951DDCF2}'] 70 | end; 71 | 72 | (* 73 | IGraphQLArgument = interface; 74 | 75 | IGraphQLArguments = interface(IGraphQLList) 76 | ['{FC905724-24BA-4A91-A642-37BCAB7D6946}'] 77 | end; 78 | *) 79 | 80 | IGraphQLArgument = interface 81 | ['{9740320C-AC4E-47F4-BAA1-8C9EB7D7BEAB}'] 82 | function GetName: string; 83 | function GetValue: TValue; 84 | function GetArgumentType: TGraphQLVariableType; 85 | function GetAttributes: TGraphQLArgumentAttributes; 86 | function GetSubArguments: IGraphQLArgument; 87 | 88 | property Name: string read GetName; 89 | property ArgumentType: TGraphQLVariableType read GetArgumentType; 90 | property Value: TValue read GetValue; 91 | property Attributes: TGraphQLArgumentAttributes read GetAttributes; 92 | property SubArguments: IGraphQLArgument read GetSubArguments; 93 | end; 94 | 95 | IGraphQLField = interface 96 | ['{9C7313F8-7953-4F9E-876B-69B2CDE60865}'] 97 | function GetFieldName: string; 98 | function GetFieldAlias: string; 99 | function GetValue: IGraphQLValue; 100 | function GetArguments: IGraphQLList; 101 | function ArgumentCount: Integer; 102 | function ArgumentByName(const AName: string): IGraphQLArgument; 103 | function GetParentField: IGraphQLField; 104 | 105 | property ParentField: IGraphQLField read GetParentField; 106 | property FieldName: string read GetFieldName; 107 | property FieldAlias: string read GetFieldAlias; 108 | property Value: IGraphQLValue read GetValue; 109 | property Arguments: IGraphQLList read GetArguments; 110 | end; 111 | 112 | IGraphQLNull = interface(IGraphQLValue) 113 | ['{04FF0371-2034-49E3-9977-810A2DD54E44}'] 114 | end; 115 | 116 | IGraphQLObject = interface(IGraphQLValue) 117 | ['{80B1FD62-50BA-4000-8C3C-79FF8F52159E}'] 118 | function FieldCount: Integer; 119 | function GetFields: IGraphQLList; 120 | function GetFieldByName(const AName: string): IGraphQLField; 121 | function FindFieldByName(const AName: string): IGraphQLField; 122 | 123 | property Fields: IGraphQLList read GetFields; 124 | property FieldByName[const AName: string]: IGraphQLField read GetFieldByName; 125 | end; 126 | 127 | IGraphQLParam = interface 128 | ['{0A306CB8-F0C9-4F93-B237-2993C6370ADF}'] 129 | function GetParamName: string; 130 | procedure SetParamName(const LValue: string); 131 | function GetParamType: TGraphQLVariableType; 132 | procedure SetParamType(LValue: TGraphQLVariableType); 133 | function GetRequired: Boolean; 134 | procedure SetRequired(LValue: Boolean); 135 | function GetDefaultValue: TValue; 136 | procedure SetDefaultValue(LValue: TValue); 137 | 138 | property ParamName: string read GetParamName write SetParamName; 139 | property ParamType: TGraphQLVariableType read GetParamType write SetParamType; 140 | property Required: Boolean read GetRequired write SetRequired; 141 | property DefaultValue: TValue read GetDefaultValue write SetDefaultValue; 142 | end; 143 | 144 | IGraphQL = interface 145 | ['{68BCD39F-A645-4007-8FA3-632359041A68}'] 146 | function GetName: string; 147 | procedure SetName(const AName: string); 148 | procedure AddField(AField: IGraphQLField); 149 | function FieldCount: Integer; 150 | 151 | function GetFields: IGraphQLList; 152 | function GetParams: IGraphQLList; 153 | procedure AddParam(AParam: IGraphQLParam); 154 | function ParamCount: Integer; 155 | function ParamByName(const AName: string): IGraphQLParam; 156 | function FieldByName(const AName: string): IGraphQLField; 157 | 158 | property Fields: IGraphQLList read GetFields; 159 | property Params: IGraphQLList read GetParams; 160 | property Name: string read GetName write SetName; 161 | end; 162 | 163 | function VariableTypeToStr(AParamType: TGraphQLVariableType): string; 164 | 165 | implementation 166 | 167 | function VariableTypeToStr(AParamType: TGraphQLVariableType): string; 168 | const 169 | LTypeStr: array [TGraphQLVariableType] of string = ( 170 | 'Unknown', 171 | 'String', 172 | 'Int', 173 | 'Float', 174 | 'Boolean', 175 | 'ID', 176 | 'Object', 177 | 'Array' 178 | ); 179 | begin 180 | Result := LTypeStr[AParamType]; 181 | end; 182 | 183 | end. 184 | -------------------------------------------------------------------------------- /Source/GraphQL.Query.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi GraphQL } 4 | { Copyright (c) 2022 Luca Minuti } 5 | { https://github.com/lminuti/graphql } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | unit GraphQL.Query; 23 | 24 | interface 25 | 26 | uses 27 | System.Classes, System.SysUtils, System.Rtti, System.JSON, Generics.Collections, 28 | GraphQL.Core, GraphQL.Resolver.Core; 29 | 30 | type 31 | TGraphQLFunc = reference to function (AContext: TObject; AParams: TGraphQLParams) :TValue; 32 | 33 | TGraphQLSerializerFunc = reference to function (AObject: TObject) :TJSONObject; 34 | 35 | TGraphQLFunctionRegistry = class(TDictionary) 36 | end; 37 | 38 | TGraphQLResolverRegistry = class(TList) 39 | end; 40 | 41 | TOnNeedVariableEvent = procedure (Sender: TObject; AArgument: IGraphQLArgument; var AValue: TValue) of object; 42 | TOnFreeObjectEvent = procedure (Sender: TObject; AObjectToFree: TObject; var AAutoFree: Boolean) of object; 43 | 44 | TGraphQLQuery = class(TObject) 45 | private 46 | FFunctionRegistry: TGraphQLFunctionRegistry; 47 | FResolverRegistry: TGraphQLResolverRegistry; 48 | FSerializerFunc: TGraphQLSerializerFunc; 49 | FOnNeedVariable: TOnNeedVariableEvent; 50 | FAutoFree: Boolean; 51 | FOnFreeObject: TOnFreeObjectEvent; 52 | function GetVariable(AGraphQL: IGraphQL; LArgument: IGraphQLArgument; AVariables: IGraphQLVariables): TValue; 53 | function Resolve(AContext: TGraphQLContext; AParams: TGraphQLParams): TValue; overload; 54 | function Resolve(AContext: TGraphQLContext; AField: IGraphQLField; AParent: TJSONObject): TValue; overload; 55 | function ObjectToJSON(AContext: TGraphQLContext; AObject: TObject; AGraphQLObject: IGraphQLObject): TJSONValue; 56 | function ValueToJSON(AContext: TGraphQLContext; AValue: TValue; AField: IGraphQLField): TJSONValue; 57 | public 58 | procedure RegisterFunction(const AFunctionName: string; AFunc: TGraphQLFunc); 59 | procedure RegisterResolver(AResolver: IGraphQLResolver); 60 | procedure RegisterSerializer(AFunc: TGraphQLSerializerFunc); 61 | 62 | function Parse(const AQuery: string): IGraphQL; 63 | function Run(const AQuery: string; AVariables: IGraphQLVariables): string; overload; 64 | function Run(AGraphQL: IGraphQL; AVariables: IGraphQLVariables): string; overload; 65 | function Run(AGraphQL: IGraphQL; AVariables: IGraphQLVariables; AContext: TObject): string; overload; 66 | function Run(const AQuery: string; AVariables: IGraphQLVariables; AContext: TObject): string; overload; 67 | 68 | property OnNeedVariable: TOnNeedVariableEvent read FOnNeedVariable write FOnNeedVariable; 69 | property OnFreeObject: TOnFreeObjectEvent read FOnFreeObject write FOnFreeObject; 70 | property AutoFree: Boolean read FAutoFree write FAutoFree default True; 71 | 72 | constructor Create; 73 | destructor Destroy; override; 74 | end; 75 | 76 | implementation 77 | 78 | { TGraphQLQuery } 79 | 80 | uses 81 | REST.Json, 82 | GraphQL.Lexer.Core, GraphQL.SyntaxAnalysis.Builder, GraphQL.Utils.JSON; 83 | 84 | constructor TGraphQLQuery.Create; 85 | begin 86 | FAutoFree := True; 87 | FFunctionRegistry := TGraphQLFunctionRegistry.Create; 88 | FResolverRegistry := TGraphQLResolverRegistry.Create; 89 | FSerializerFunc := 90 | function(AObject: TObject) :TJSONObject 91 | begin 92 | Result := TJson.ObjectToJsonObject(AObject); 93 | end; 94 | end; 95 | 96 | destructor TGraphQLQuery.Destroy; 97 | begin 98 | FFunctionRegistry.Free; 99 | FResolverRegistry.Free; 100 | inherited; 101 | end; 102 | 103 | function TGraphQLQuery.GetVariable(AGraphQL: IGraphQL; LArgument: IGraphQLArgument; AVariables: IGraphQLVariables): TValue; 104 | begin 105 | if AVariables.VariableExists(LArgument.Name) then 106 | begin 107 | Exit(AVariables.GetVariable(LArgument.Name)); 108 | end; 109 | 110 | if Assigned(FOnNeedVariable) then 111 | begin 112 | FOnNeedVariable(Self, LArgument, Result); 113 | Exit; 114 | end; 115 | 116 | Result := AGraphQL.ParamByName(LArgument.Name).DefaultValue; 117 | 118 | if Result.IsEmpty then 119 | raise EGraphQLError.CreateFmt('Variable [%s] not found', [LArgument.Name]); 120 | end; 121 | 122 | procedure TGraphQLQuery.RegisterFunction(const AFunctionName: string; 123 | AFunc: TGraphQLFunc); 124 | begin 125 | FFunctionRegistry.Add(AFunctionName, AFunc); 126 | end; 127 | 128 | procedure TGraphQLQuery.RegisterResolver(AResolver: IGraphQLResolver); 129 | begin 130 | FResolverRegistry.Add(AResolver); 131 | end; 132 | 133 | procedure TGraphQLQuery.RegisterSerializer(AFunc: TGraphQLSerializerFunc); 134 | begin 135 | FSerializerFunc := AFunc; 136 | end; 137 | 138 | function TGraphQLQuery.Resolve(AContext: TGraphQLContext; AField: IGraphQLField; AParent: TJSONObject): TValue; 139 | var 140 | LArgument: IGraphQLArgument; 141 | LParams: TGraphQLParams; 142 | LParamDictionary: TDictionary; 143 | LFieldName: string; 144 | begin 145 | LParamDictionary := TDictionary.Create; 146 | try 147 | for LArgument in AField.Arguments do 148 | begin 149 | if TGraphQLArgumentAttribute.Variable in LArgument.Attributes then 150 | LParamDictionary.Add(LArgument.Name, GetVariable(AContext.GraphQL, LArgument, AContext.Variables)) 151 | else 152 | LParamDictionary.Add(LArgument.Name, LArgument.Value); 153 | end; 154 | 155 | if Assigned(AField.ParentField) then 156 | LFieldName := AField.ParentField.FieldName + '/' + AField.FieldName 157 | else 158 | LFieldName := AField.FieldName; 159 | 160 | LParams := TGraphQLParams.Create(LFieldName, LParamDictionary, AParent); 161 | Result := Resolve(AContext, LParams); 162 | finally 163 | LParamDictionary.Free; 164 | end; 165 | end; 166 | 167 | function TGraphQLQuery.Run(const AQuery: string; AVariables: IGraphQLVariables; 168 | AContext: TObject): string; 169 | var 170 | LGraphQL: IGraphQL; 171 | begin 172 | inherited; 173 | LGraphQL := Parse(AQuery); 174 | Result := Run(LGraphQL, AVariables, AContext); 175 | end; 176 | 177 | function TGraphQLQuery.Resolve(AContext: TGraphQLContext; AParams: TGraphQLParams): TValue; 178 | var 179 | LFunc: TGraphQLFunc; 180 | LResolver: IGraphQLResolver; 181 | begin 182 | Result := nil; 183 | if FFunctionRegistry.TryGetValue(AParams.FieldName, LFunc) then 184 | Exit(LFunc(AContext, AParams)); 185 | 186 | for LResolver in FResolverRegistry do 187 | begin 188 | Result := LResolver.Resolve(AContext.Data, AParams); 189 | if not Result.IsEmpty then 190 | Exit; 191 | end; 192 | 193 | raise EGraphQLError.CreateFmt('Entity [%s] not found', [AParams.FieldName]); 194 | end; 195 | 196 | function TGraphQLQuery.Run(AGraphQL: IGraphQL; AVariables: IGraphQLVariables; AContext: TObject): string; 197 | var 198 | LField: IGraphQLField; 199 | LJSONObject: TJSONObject; 200 | LContext: TGraphQLContext; 201 | begin 202 | LContext := TGraphQLContext.Create(AGraphQL, AVariables, AContext); 203 | try 204 | LJSONObject := TJSONObject.Create; 205 | try 206 | for LField in AGraphQL.Fields do 207 | begin 208 | LJSONObject.AddPair(LField.FieldAlias, ValueToJSON(LContext, Resolve(LContext, LField, nil), LField)); 209 | end; 210 | Result := LJSONObject.ToJSON; 211 | finally 212 | LJSONObject.Free; 213 | end; 214 | finally 215 | LContext.Free; 216 | end; 217 | end; 218 | 219 | function TGraphQLQuery.Run(AGraphQL: IGraphQL; 220 | AVariables: IGraphQLVariables): string; 221 | begin 222 | Result := Run(AGraphQL, AVariables, nil); 223 | end; 224 | 225 | function TGraphQLQuery.ValueToJSON(AContext: TGraphQLContext; AValue: TValue; AField: IGraphQLField): TJSONValue; 226 | var 227 | LGraphQLObject: IGraphQLObject; 228 | LIndex: Integer; 229 | LJsonValue: TJSONValue; 230 | LJsonArray: TJSONArray; 231 | LAutoFree: Boolean; 232 | begin 233 | case AValue.Kind of 234 | tkInteger: Result := TJSONNumber.Create(AValue.AsInteger); 235 | tkString, 236 | tkLString, 237 | tkWString, 238 | tkUString: Result := TJSONString.Create(AValue.AsString); 239 | tkClass: begin 240 | LAutoFree := FAutoFree; 241 | if Supports(AField.Value, IGraphQLObject) then 242 | LGraphQLObject := AField.Value as IGraphQLObject 243 | else 244 | LGraphQLObject := nil; 245 | 246 | try 247 | Result := ObjectToJSON(AContext, AValue.AsObject, LGraphQLObject); 248 | finally 249 | if Assigned(FOnFreeObject) then 250 | FOnFreeObject(Self, AValue.AsObject, LAutoFree); 251 | if LAutoFree then 252 | AValue.AsObject.Free; 253 | end; 254 | end; 255 | tkFloat: Result := TJSONNumber.Create(AValue.AsExtended); 256 | tkInt64: Result := TJSONNumber.Create(AValue.AsInt64); 257 | tkDynArray: begin 258 | LJsonArray := TJSONArray.Create; 259 | try 260 | for LIndex := 0 to AValue.GetArrayLength - 1 do 261 | begin 262 | LJsonValue := ValueToJSON(AContext, AValue.GetArrayElement(LIndex), AField); 263 | LJsonArray.AddElement(LJsonValue); 264 | end; 265 | except 266 | LJsonArray.Free; 267 | raise; 268 | end; 269 | Result := LJsonArray; 270 | end; 271 | // tkClassRef 272 | // tkChar, 273 | // tkEnumeration, 274 | // tkSet, 275 | // tkWChar, 276 | // tkVariant, 277 | // tkArray, 278 | // tkRecord, 279 | // tkInterface, 280 | // tkDynArray, 281 | // tkPointer, 282 | else 283 | raise EGraphQLError.CreateFmt('Value [%s] not supported', [TRttiEnumerationType.GetName(AValue.Kind)]); 284 | end; 285 | end; 286 | 287 | function TGraphQLQuery.ObjectToJSON(AContext: TGraphQLContext; AObject: TObject; AGraphQLObject: IGraphQLObject): TJSONValue; 288 | 289 | function CloneObject(LJSONObject: TJSONObject; AGraphQLObject: IGraphQLObject): TJSONObject; forward; 290 | 291 | function CloneValue(LValue: TJSONValue; AGraphQLValue: IGraphQLValue): TJSONValue; 292 | var 293 | LGraphQLSubObject: IGraphQLObject; 294 | LSubArray: TJSONArray; 295 | LItem: TJSONValue; 296 | LSubObject: TJSONObject; 297 | begin 298 | //Result := nil; 299 | if LValue is TJSONArray then 300 | begin 301 | LGraphQLSubObject := nil; 302 | if Supports(AGraphQLValue, IGraphQLObject) then 303 | LGraphQLSubObject := AGraphQLValue as IGraphQLObject; 304 | 305 | LSubArray := TJSONArray.Create; 306 | for LItem in (LValue as TJSONArray) do 307 | begin 308 | LSubObject := CloneObject(LItem as TJSONObject, LGraphQLSubObject); 309 | LSubArray.AddElement(LSubObject); 310 | end; 311 | Result := LSubArray; 312 | end 313 | else if LValue is TJSONObject then 314 | begin 315 | LGraphQLSubObject := nil; 316 | if Supports(AGraphQLValue, IGraphQLObject) then 317 | LGraphQLSubObject := AGraphQLValue as IGraphQLObject; 318 | LSubObject := CloneObject(LValue as TJSONObject, LGraphQLSubObject); 319 | Result := LSubObject; 320 | end 321 | else if LValue is TJSONNull then 322 | Result := TJSONNull.Create 323 | else if LValue is TJSONBool then 324 | Result := TJSONBool.Create(TJSONBool(LValue).AsBoolean) 325 | else if LValue is TJSONNumber then 326 | Result := TJSONNumber.Create(TJSONNumber(LValue).AsDouble) 327 | else if LValue is TJSONString then 328 | Result := TJSONString.Create(LValue.Value) 329 | else 330 | raise Exception.CreateFmt('Value [%s] not suppported', [LValue.ClassName]); 331 | end; 332 | 333 | function CloneObject(LJSONObject: TJSONObject; AGraphQLObject: IGraphQLObject): TJSONObject; 334 | var 335 | LClonedObject: TJSONObject; 336 | LField: IGraphQLField; 337 | LValue: TJSONValue; 338 | LClonedValue: TJSONValue; 339 | LFreeValue: Boolean; 340 | begin 341 | if not Assigned(AGraphQLObject) then 342 | Exit(nil); 343 | 344 | LClonedObject := TJSONObject.Create; 345 | try 346 | 347 | for LField in AGraphQLObject.Fields do 348 | begin 349 | LFreeValue := False; 350 | LValue := LJSONObject.Values[LField.FieldName]; 351 | try 352 | 353 | if not Assigned(LValue) then 354 | begin 355 | LValue := ValueToJSON(AContext, Resolve(AContext, LField, LJSONObject), LField); 356 | LFreeValue := True; 357 | end; 358 | 359 | if Assigned(LValue) then 360 | begin 361 | LClonedValue := CloneValue(LValue, LField.Value); 362 | if Assigned(LClonedValue) then 363 | LClonedObject.AddPair(LField.FieldAlias, LClonedValue); 364 | end; 365 | finally 366 | if LFreeValue and Assigned(LValue) then 367 | LValue.Free; 368 | end; 369 | end; 370 | Result := LClonedObject; 371 | except 372 | LClonedObject.Free; 373 | raise; 374 | end; 375 | end; 376 | 377 | var 378 | LJSONObject: TJSONObject; 379 | LJSONFilteredObject: TJSONValue; 380 | begin 381 | if AObject is TJSONArray then 382 | begin 383 | LJSONFilteredObject := CloneValue(TJSONArray(AObject), AGraphQLObject); 384 | Exit(LJSONFilteredObject); 385 | end; 386 | 387 | if AObject is TJSONObject then 388 | begin 389 | LJSONObject := TJSONObject(AObject) 390 | end 391 | else 392 | begin 393 | LJSONObject := FSerializerFunc(AObject); 394 | end; 395 | 396 | if not Assigned(AGraphQLObject) then 397 | begin 398 | LJSONFilteredObject := LJSONObject; 399 | end 400 | else 401 | begin 402 | try 403 | LJSONFilteredObject := CloneObject(LJSONObject, AGraphQLObject); 404 | finally 405 | if LJSONObject <> AObject then 406 | LJSONObject.Free; 407 | end; 408 | end; 409 | Result := LJSONFilteredObject; 410 | end; 411 | 412 | function TGraphQLQuery.Parse(const AQuery: string): IGraphQL; 413 | var 414 | LBuilder: TGraphQLBuilder; 415 | begin 416 | inherited; 417 | LBuilder := TGraphQLBuilder.Create(AQuery); 418 | try 419 | Result := LBuilder.Build; 420 | finally 421 | LBuilder.Free; 422 | end; 423 | end; 424 | 425 | function TGraphQLQuery.Run(const AQuery: string; AVariables: IGraphQLVariables): string; 426 | var 427 | LGraphQL: IGraphQL; 428 | begin 429 | inherited; 430 | LGraphQL := Parse(AQuery); 431 | Result := Run(LGraphQL, AVariables); 432 | end; 433 | 434 | end. 435 | -------------------------------------------------------------------------------- /Source/GraphQL.Resolver.Core.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi GraphQL } 4 | { Copyright (c) 2022 Luca Minuti } 5 | { https://github.com/lminuti/graphql } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | unit GraphQL.Resolver.Core; 23 | 24 | interface 25 | 26 | uses 27 | System.Classes, System.SysUtils, System.Rtti, System.JSON, Generics.Collections, 28 | GraphQL.Core; 29 | 30 | type 31 | TGraphQLParams = record 32 | private 33 | FFieldName: string; 34 | FParams: TDictionary; 35 | FParent: TJSONObject; 36 | public 37 | function Get(const AName: string): TValue; 38 | function Exists(const AName: string): Boolean; 39 | function Count: Integer; 40 | function GetEnumerator: TDictionary.TPairEnumerator; 41 | 42 | property FieldName: string read FFieldName; 43 | property Parent: TJSONObject read FParent; 44 | 45 | constructor Create(const AFieldName: string; AParams: TDictionary; AParent: TJSONObject); 46 | end; 47 | 48 | IGraphQLResolver = interface 49 | ['{31891A84-FC2B-479A-8D35-8E5EDD3CC359}'] 50 | function Resolve(AContext: TObject; AParams: TGraphQLParams): TValue; 51 | end; 52 | 53 | IGraphQLVariables = interface 54 | ['{6DF8CDD1-B969-49AD-96EC-F555A08C9576}'] 55 | procedure Clear; 56 | function SetVariable(const AName: string; AValue: TValue): IGraphQLVariables; 57 | function GetVariable(const AName: string): TValue; 58 | function VariableExists(const AName: string): Boolean; 59 | end; 60 | 61 | TGraphQLVariables = class(TInterfacedObject, IGraphQLVariables) 62 | private 63 | FVariables: TDictionary; 64 | procedure Clear; 65 | function SetVariable(const AName: string; AValue: TValue): IGraphQLVariables; 66 | function GetVariable(const AName: string): TValue; 67 | function VariableExists(const AName: string): Boolean; 68 | public 69 | constructor Create; 70 | destructor Destroy; override; 71 | end; 72 | 73 | TGraphQLContext = class 74 | private 75 | FGraphQL: IGraphQL; 76 | FVariables: IGraphQLVariables; 77 | FData: TObject; 78 | public 79 | property GraphQL: IGraphQL read FGraphQL; 80 | property Variables: IGraphQLVariables read FVariables; 81 | property Data: TObject read FData; 82 | 83 | constructor Create(AGraphQL: IGraphQL; AVariables: IGraphQLVariables; AData: TObject); 84 | end; 85 | 86 | 87 | implementation 88 | 89 | { TGraphQLParams } 90 | 91 | function TGraphQLParams.Count: Integer; 92 | begin 93 | Result := FParams.Count; 94 | end; 95 | 96 | constructor TGraphQLParams.Create(const AFieldName: string; 97 | AParams: TDictionary; AParent: TJSONObject); 98 | begin 99 | FFieldName := AFieldName; 100 | FParams := AParams; 101 | FParent := AParent; 102 | end; 103 | 104 | function TGraphQLParams.Exists(const AName: string): Boolean; 105 | begin 106 | Result := FParams.ContainsKey(AName); 107 | end; 108 | 109 | function TGraphQLParams.Get(const AName: string): TValue; 110 | begin 111 | Result := FParams.Items[AName]; 112 | end; 113 | 114 | function TGraphQLParams.GetEnumerator: TDictionary.TPairEnumerator; 115 | begin 116 | Result := FParams.GetEnumerator; 117 | end; 118 | 119 | { TGraphQLVariables } 120 | 121 | procedure TGraphQLVariables.Clear; 122 | begin 123 | FVariables.Clear; 124 | end; 125 | 126 | constructor TGraphQLVariables.Create; 127 | begin 128 | inherited; 129 | FVariables := TDictionary.Create; 130 | end; 131 | 132 | destructor TGraphQLVariables.Destroy; 133 | begin 134 | FVariables.Free; 135 | inherited; 136 | end; 137 | 138 | function TGraphQLVariables.GetVariable(const AName: string): TValue; 139 | begin 140 | Result := FVariables[AName]; 141 | end; 142 | 143 | function TGraphQLVariables.SetVariable(const AName: string; 144 | AValue: TValue): IGraphQLVariables; 145 | begin 146 | FVariables.AddOrSetValue(AName, AValue); 147 | Result := Self; 148 | end; 149 | 150 | function TGraphQLVariables.VariableExists(const AName: string): Boolean; 151 | begin 152 | Result := FVariables.ContainsKey(AName); 153 | end; 154 | 155 | { TGraphQLContext } 156 | 157 | constructor TGraphQLContext.Create(AGraphQL: IGraphQL; AVariables: IGraphQLVariables; AData: TObject); 158 | begin 159 | inherited Create; 160 | FGraphQL := AGraphQL; 161 | FVariables := AVariables; 162 | FData := AData; 163 | end; 164 | 165 | end. 166 | -------------------------------------------------------------------------------- /Source/GraphQL.Resolver.ReST.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi GraphQL } 4 | { Copyright (c) 2022 Luca Minuti } 5 | { https://github.com/lminuti/graphql } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | unit GraphQL.Resolver.ReST; 23 | 24 | interface 25 | 26 | uses 27 | System.Classes, System.SysUtils, System.Rtti, System.TypInfo, System.JSON, System.NetEncoding, Generics.Collections, 28 | GraphQL.Core, GraphQL.Resolver.Core, IdHttp, System.RegularExpressions; 29 | 30 | type 31 | IGraphQLHTTPResponse = interface 32 | ['{F7DDEEE1-13B7-4EAA-927F-55F680B0FBFC}'] 33 | function Header(const AName: string): string; 34 | function ContentText: string; 35 | end; 36 | 37 | TGraphQLHTTPRequestEvent = procedure (AContext: TObject; AHttpClient: TIdHttp) of object; 38 | 39 | TGraphQLHTTPResponse = class(TInterfacedObject, IGraphQLHTTPResponse) 40 | protected 41 | FHeaders: TDictionary; 42 | FContextText: string; 43 | public 44 | { IGraphQLHTTPResponse } 45 | function ContentText: string; virtual; 46 | function Header(const AName: string): string; virtual; 47 | 48 | constructor Create; 49 | destructor Destroy; override; 50 | end; 51 | 52 | TGraphQLReSTEntity = class 53 | private 54 | FEntity: string; 55 | FIdProperty: string; 56 | FUrl: string; 57 | FParentEntityName: string; 58 | public 59 | property Entity: string read FEntity; 60 | property Url: string read FUrl; 61 | property IdProperty: string read FIdProperty; 62 | property ParentEntityName: string read FParentEntityName; 63 | 64 | constructor Create(AEntity, AUrl, AIdProperty: string); 65 | end; 66 | 67 | TGraphQLReSTResolver = class(TInterfacedObject, IGraphQLResolver) 68 | private 69 | FEntityMap: TObjectDictionary; 70 | FHTTPRequestBuilder: TFunc; 71 | FBeforeRequestEvent: TGraphQLHTTPRequestEvent; 72 | FAfterRequestEvent: TGraphQLHTTPRequestEvent; 73 | function BuildUrl(AEntity: TGraphQLReSTEntity; AParams: TGraphQLParams): string; 74 | function ValueToString(LValue: TValue): string; 75 | function MakeHTTPRequest(const AUrl: string; AContext: TObject): IGraphQLHTTPResponse; 76 | procedure InitRequestBuilder; 77 | public 78 | { IGraphQLResolver } 79 | function Resolve(AContext: TObject; AParams: TGraphQLParams): TValue; 80 | procedure MapEntity(const AEntity, AUrl: string; const AIdProperty: string = 'id'); 81 | 82 | property BeforeRequestEvent: TGraphQLHTTPRequestEvent read FBeforeRequestEvent write FBeforeRequestEvent; 83 | property AfterRequestEvent: TGraphQLHTTPRequestEvent read FAfterRequestEvent write FAfterRequestEvent; 84 | property HTTPRequestBuilder: TFunc read FHTTPRequestBuilder write FHTTPRequestBuilder; 85 | constructor Create; 86 | destructor Destroy; override; 87 | end; 88 | 89 | implementation 90 | 91 | type 92 | TGraphQLHTTPResponseIndy = class(TGraphQLHTTPResponse) 93 | public 94 | constructor Create(const AContentText: string; AResponse: TIdHTTPResponse); 95 | end; 96 | 97 | { TGraphQLReSTResolver } 98 | 99 | constructor TGraphQLReSTResolver.Create; 100 | begin 101 | inherited Create; 102 | FEntityMap := TObjectDictionary.Create([doOwnsValues]); 103 | InitRequestBuilder; 104 | end; 105 | 106 | destructor TGraphQLReSTResolver.Destroy; 107 | begin 108 | FEntityMap.Free; 109 | inherited; 110 | end; 111 | 112 | procedure TGraphQLReSTResolver.InitRequestBuilder; 113 | begin 114 | FHTTPRequestBuilder := 115 | function (AUrl: string; AContent: TObject): IGraphQLHTTPResponse 116 | var 117 | LHttpClient: TIdHttp; 118 | LResponseText: string; 119 | begin 120 | LHttpClient := TIdHTTP.Create(nil); 121 | try 122 | if Assigned(FBeforeRequestEvent) then 123 | FBeforeRequestEvent(AContent, LHttpClient); 124 | LResponseText := LHttpClient.Get(AUrl); 125 | if Assigned(FAfterRequestEvent) then 126 | FAfterRequestEvent(AContent, LHttpClient); 127 | Result := TGraphQLHTTPResponseIndy.Create(LResponseText, LHttpClient.Response); 128 | finally 129 | LHttpClient.Free; 130 | end; 131 | end; 132 | 133 | end; 134 | 135 | procedure TGraphQLReSTResolver.MapEntity(const AEntity, 136 | AUrl, AIdProperty: string); 137 | begin 138 | FEntityMap.Add(AEntity, TGraphQLReSTEntity.Create(AEntity, AUrl, AIdProperty)); 139 | end; 140 | 141 | function TGraphQLReSTResolver.ValueToString(LValue: TValue): string; 142 | const 143 | BoolStr: array [Boolean] of string = ('false', 'true'); 144 | begin 145 | case LValue.Kind of 146 | tkEnumeration: begin 147 | if LValue.TypeInfo = TypeInfo(Boolean) then 148 | Result := BoolStr[LValue.AsBoolean] 149 | else 150 | Result := LValue.ToString; 151 | end; 152 | else 153 | Result := LValue.ToString; 154 | end; 155 | end; 156 | 157 | function TGraphQLReSTResolver.BuildUrl(AEntity: TGraphQLReSTEntity; AParams: TGraphQLParams): string; 158 | var 159 | LParamPair: TPair; 160 | LQueryParams: string; 161 | LMatches: TMatchCollection; 162 | LMatch: TMatch; 163 | LValue: string; 164 | LParentIdProperty: string; 165 | LParentEntity: TGraphQLReSTEntity; 166 | begin 167 | Result := AEntity.Url; 168 | LQueryParams := ''; 169 | for LParamPair in AParams do 170 | begin 171 | LValue := ValueToString(LParamPair.Value); 172 | if Pos('{' + LParamPair.Key + '}', Result) > 0 then 173 | Result := StringReplace(Result, '{' + LParamPair.Key + '}', TNetEncoding.URL.EncodeQuery(LValue), []) 174 | else 175 | begin 176 | LQueryParams := LQueryParams + TNetEncoding.URL.EncodeQuery(LParamPair.Key) + '=' + TNetEncoding.URL.EncodeQuery(LValue) + '&'; 177 | end; 178 | end; 179 | 180 | if Assigned(AParams.Parent) then 181 | begin 182 | LParentIdProperty := 'id'; 183 | if FEntityMap.TryGetValue(AEntity.ParentEntityName, LParentEntity) then 184 | LParentIdProperty := LParentEntity.IdProperty; 185 | Result := StringReplace(Result, '{parentId}', TNetEncoding.URL.EncodeQuery(AParams.Parent.GetValue(LParentIdProperty)), []); 186 | end; 187 | 188 | // Strip templates 189 | LMatches := TRegEx.Matches(Result, '\{.+\}'); 190 | for LMatch in LMatches do 191 | begin 192 | Result := StringReplace(Result, LMatch.Value, '', []); 193 | end; 194 | 195 | if LQueryParams <> '' then 196 | Result := Result + '?' + LQueryParams; 197 | 198 | end; 199 | 200 | function TGraphQLReSTResolver.MakeHTTPRequest(const AUrl: string; AContext: TObject): IGraphQLHTTPResponse; 201 | begin 202 | if not Assigned(FHTTPRequestBuilder) then 203 | raise EGraphQLError.Create('FHTTPRequestBuilder not assigned'); 204 | 205 | Result := FHTTPRequestBuilder(AUrl, AContext); 206 | end; 207 | 208 | function TGraphQLReSTResolver.Resolve(AContext: TObject; AParams: TGraphQLParams): TValue; 209 | var 210 | LEntity: TGraphQLReSTEntity; 211 | LHTTPResponse: IGraphQLHTTPResponse; 212 | LUrl: string; 213 | begin 214 | if FEntityMap.TryGetValue(AParams.FieldName, LEntity) then 215 | begin 216 | LUrl := BuildUrl(LEntity, AParams); 217 | 218 | LHTTPResponse := MakeHTTPRequest(LUrl, AContext); 219 | 220 | if LHTTPResponse.Header('Content-Type').Contains('application/json') then 221 | Result := TJSONObject.ParseJSONValue(LHTTPResponse.ContentText) 222 | else 223 | Result := LHTTPResponse.ContentText; 224 | end; 225 | end; 226 | 227 | { TGraphQLHTTPResponse } 228 | 229 | function TGraphQLHTTPResponse.ContentText: string; 230 | begin 231 | Result := FContextText; 232 | end; 233 | 234 | constructor TGraphQLHTTPResponse.Create; 235 | begin 236 | inherited; 237 | FHeaders := TDictionary.Create; 238 | end; 239 | 240 | destructor TGraphQLHTTPResponse.Destroy; 241 | begin 242 | FHeaders.Free; 243 | inherited; 244 | end; 245 | 246 | function TGraphQLHTTPResponse.Header(const AName: string): string; 247 | begin 248 | if not FHeaders.TryGetValue(AName, Result) then 249 | Result := ''; 250 | end; 251 | 252 | { TGraphQLHTTPResponseIndy } 253 | 254 | constructor TGraphQLHTTPResponseIndy.Create(const AContentText: string; AResponse: TIdHTTPResponse); 255 | var 256 | LIndex: Integer; 257 | LHeaderName: string; 258 | begin 259 | inherited Create; 260 | FContextText := AContentText; 261 | for LIndex := 0 to AResponse.RawHeaders.Count - 1 do 262 | begin 263 | LHeaderName := AResponse.RawHeaders.Names[LIndex]; 264 | FHeaders.Add(LHeaderName, AResponse.RawHeaders.Values[LHeaderName]); 265 | end; 266 | end; 267 | 268 | { TGraphQLReSTEntity } 269 | 270 | constructor TGraphQLReSTEntity.Create(AEntity, AUrl, AIdProperty: string); 271 | var 272 | LEntityNamePair: TArray; 273 | begin 274 | inherited Create; 275 | FEntity := AEntity; 276 | FUrl := AUrl; 277 | FIdProperty := AIdProperty; 278 | 279 | LEntityNamePair := FEntity.Split(['/']); 280 | if Length(LEntityNamePair) > 1 then 281 | FParentEntityName := LEntityNamePair[0] 282 | else 283 | FParentEntityName := ''; 284 | end; 285 | 286 | end. 287 | -------------------------------------------------------------------------------- /Source/GraphQL.Resolver.Rtti.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi GraphQL } 4 | { Copyright (c) 2022 Luca Minuti } 5 | { https://github.com/lminuti/graphql } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | unit GraphQL.Resolver.Rtti; 23 | 24 | interface 25 | 26 | uses 27 | System.Classes, System.SysUtils, System.Rtti, System.JSON, System.SyncObjs, 28 | GraphQL.Core, GraphQL.Resolver.Core; 29 | 30 | type 31 | TGraphQLRttiResolver = class(TInterfacedObject, IGraphQLResolver) 32 | private 33 | FClass: TClass; 34 | FClassFactory: TFunc; 35 | FSingleton: Boolean; 36 | FInstance: TObject; 37 | function CreateInstance: TObject; 38 | public 39 | { IGraphQLResolver } 40 | function Resolve(AContext: TObject; AParams: TGraphQLParams): TValue; 41 | 42 | constructor Create(AClass: TClass; AClassFactory: TFunc = nil; ASingleton: Boolean = False); overload; 43 | constructor Create(AClass: TClass; ASingleton: Boolean); overload; 44 | destructor Destroy; override; 45 | end; 46 | 47 | implementation 48 | 49 | { TGraphQLRttiResolver } 50 | 51 | uses 52 | GraphQL.Utils.Rtti, GraphQL.Core.Attributes; 53 | 54 | var 55 | CreateInstanceLock: TCriticalSection; 56 | 57 | constructor TGraphQLRttiResolver.Create(AClass: TClass; AClassFactory: TFunc = nil; ASingleton: Boolean = False); 58 | begin 59 | FClass := AClass; 60 | FSingleton := ASingleton; 61 | FInstance := nil; 62 | if Assigned(AClassFactory) then 63 | begin 64 | FClassFactory := AClassFactory 65 | end 66 | else 67 | begin 68 | FClassFactory := function: TObject 69 | begin 70 | Result := TRttiHelper.CreateInstance(AClass); 71 | end 72 | end; 73 | end; 74 | 75 | constructor TGraphQLRttiResolver.Create(AClass: TClass; ASingleton: Boolean); 76 | begin 77 | Create(AClass, nil, ASingleton); 78 | end; 79 | 80 | function TGraphQLRttiResolver.CreateInstance: TObject; 81 | begin 82 | if FSingleton then 83 | begin 84 | // Double cheked locking: 85 | // Thread-safe but with lock only when the singleton has been created 86 | 87 | if not Assigned(FInstance) then 88 | begin 89 | CreateInstanceLock.Acquire; 90 | try 91 | if not Assigned(FInstance) then 92 | FInstance := FClassFactory(); 93 | finally 94 | CreateInstanceLock.Release; 95 | end; 96 | end; 97 | 98 | end 99 | else 100 | begin 101 | FInstance := FClassFactory(); 102 | end; 103 | 104 | Result := FInstance; 105 | 106 | end; 107 | 108 | destructor TGraphQLRttiResolver.Destroy; 109 | begin 110 | if FSingleton then 111 | FreeAndNil(FInstance); 112 | inherited; 113 | end; 114 | 115 | function TGraphQLRttiResolver.Resolve(AContext: TObject; AParams: TGraphQLParams): TValue; 116 | 117 | function ValueArrayFromParams(ARttiMethod: TRttiMethod; AParams: TGraphQLParams): TArray; 118 | var 119 | LRttiParam: TRttiParameter; 120 | LIndex: Integer; 121 | begin 122 | SetLength(Result, Length(ARttiMethod.GetParameters)); 123 | LIndex := 0; 124 | for LRttiParam in ARttiMethod.GetParameters do 125 | begin 126 | if AParams.Exists(LRttiParam.Name) then 127 | Result[LIndex] := AParams.Get(LRttiParam.Name); 128 | // else 129 | // raise EGraphQLError.CreateFmt('Parameter [%s] for entity [%s] not found', [LRttiParam.Name, AParams.FieldName]); 130 | Inc(LIndex); 131 | end; 132 | end; 133 | 134 | var 135 | LObject: TObject; 136 | LRttiType: TRttiType; 137 | LRttiMethod: TRttiMethod; 138 | LAttr: GraphQLEntityAttribute; 139 | LEntityName: string; 140 | begin 141 | LRttiType := TRttiHelper.Context.GetType(FClass); 142 | for LRttiMethod in LRttiType.GetMethods do 143 | begin 144 | LAttr := TRttiHelper.FindAttribute(LRttiMethod); 145 | if Assigned(LAttr) then 146 | begin 147 | if LAttr.Value <> '' then 148 | LEntityName := LAttr.Value 149 | else 150 | LEntityName := LRttiMethod.Name; 151 | 152 | if LEntityName = AParams.FieldName then 153 | begin 154 | LObject := CreateInstance; 155 | try 156 | Result := LRttiMethod.Invoke(LObject, ValueArrayFromParams(LRttiMethod, AParams)); 157 | finally 158 | if not FSingleton then 159 | FreeAndNil(LObject); 160 | end; 161 | Exit; 162 | end; 163 | end; 164 | end; 165 | end; 166 | 167 | initialization 168 | 169 | CreateInstanceLock := TCriticalSection.Create; 170 | 171 | finalization 172 | 173 | CreateInstanceLock.Free; 174 | 175 | end. 176 | -------------------------------------------------------------------------------- /Source/GraphQL.SyntaxAnalysis.Builder.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi GraphQL } 4 | { Copyright (c) 2022 Luca Minuti } 5 | { https://github.com/lminuti/graphql } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | unit GraphQL.SyntaxAnalysis.Builder; 23 | 24 | interface 25 | 26 | uses 27 | System.Classes, System.SysUtils, System.Rtti, 28 | GraphQL.Core, GraphQL.Classes, GraphQL.Lexer.Core, GraphQL.SyntaxAnalysis.Core; 29 | 30 | type 31 | TGraphQLBuilder = class(TSyntaxAnalysis) 32 | private 33 | FOwnsScanner: Boolean; 34 | 35 | { Rules } 36 | function ObjectArgumentStatement: TGraphQLArguments; 37 | function ArgumentStamement: IGraphQLArgument; 38 | procedure ArgumentsStatement(AArguments: IGraphQLList); 39 | function FieldStatement(AParentField: IGraphQLField): IGraphQLField; 40 | function ObjectStatement(AParentField: IGraphQLField): IGraphQLObject; 41 | procedure Query(AGraphQL: IGraphQL); 42 | procedure GraphQL(AGraphQL: IGraphQL); 43 | procedure Variables(AGraphQL: IGraphQL); 44 | procedure Variable(AGraphQL: IGraphQL); 45 | function TypeName(AGraphQL: IGraphQL): TGraphQLVariableType; 46 | function ArrayArgumentStatement: TGraphQLArguments; 47 | function CreateArgument(const AName: string): IGraphQLArgument; 48 | function ArrayItemArgumentStatement(AIndex: Integer): IGraphQLArgument; 49 | public 50 | function Build: IGraphQL; 51 | constructor Create(const ASourceCode :string); reintroduce; 52 | destructor Destroy; override; 53 | end; 54 | 55 | implementation 56 | 57 | { TSyntaxAnalysis } 58 | 59 | // arguments = '(' argument [ ',' argument [...] ] } '}' 60 | procedure TGraphQLBuilder.ArgumentsStatement(AArguments: IGraphQLList); 61 | begin 62 | Expect(TTokenKind.LeftParenthesis); 63 | 64 | (AArguments as IEditableList).Add(ArgumentStamement); 65 | while FToken.Kind = TTokenKind.Comma do 66 | begin 67 | NextToken; 68 | (AArguments as IEditableList).Add(ArgumentStamement); 69 | end; 70 | 71 | Expect(TTokenKind.RightParenthesis); 72 | end; 73 | 74 | // argument = identified : ( string | number | boolean | object | array | variable ) 75 | function TGraphQLBuilder.ArgumentStamement: IGraphQLArgument; 76 | var 77 | LName: string; 78 | begin 79 | Expect(TTokenKind.Identifier, False); 80 | LName := FToken.StringValue; 81 | NextToken; 82 | 83 | Expect(TTokenKind.Colon); 84 | 85 | Result := CreateArgument(LName); 86 | end; 87 | 88 | // array item = ( string | number | boolean | object | array | variable ) 89 | function TGraphQLBuilder.ArrayItemArgumentStatement(AIndex: Integer): IGraphQLArgument; 90 | var 91 | LName: string; 92 | begin 93 | LName := AIndex.ToString; 94 | 95 | Result := CreateArgument(LName); 96 | end; 97 | 98 | function TGraphQLBuilder.CreateArgument(const AName: string): IGraphQLArgument; 99 | var 100 | LType: TGraphQLVariableType; 101 | LAttributes: TGraphQLArgumentAttributes; 102 | LValue: TValue; 103 | begin 104 | LAttributes := []; 105 | 106 | case FToken.Kind of 107 | TTokenKind.LeftSquareBracket: 108 | begin 109 | LType := TGraphQLVariableType.ArrayType; 110 | LValue := ArrayArgumentStatement; 111 | end; 112 | TTokenKind.LeftCurlyBracket: 113 | begin 114 | LType := TGraphQLVariableType.ObjectType; 115 | LValue := ObjectArgumentStatement; 116 | end; 117 | TTokenKind.StringLiteral: 118 | begin 119 | LType := TGraphQLVariableType.StringType; 120 | LValue := FToken.StringValue; 121 | NextToken; 122 | end; 123 | TTokenKind.IntegerLiteral: 124 | begin 125 | LType := TGraphQLVariableType.IntType; 126 | LValue := FToken.IntegerValue; 127 | NextToken; 128 | end; 129 | TTokenKind.FloatLiteral: 130 | begin 131 | LType := TGraphQLVariableType.FloatType; 132 | LValue := FToken.FloatValue; 133 | NextToken; 134 | end; 135 | TTokenKind.Variable: 136 | begin 137 | LType := TGraphQLVariableType.UnknownType; 138 | LValue := FToken.StringValue; 139 | LAttributes := [TGraphQLArgumentAttribute.Variable]; 140 | NextToken; 141 | end; 142 | TTokenKind.Identifier: 143 | begin 144 | if FToken.StringValue = 'true' then 145 | begin 146 | LType := TGraphQLVariableType.BooleanType; 147 | LValue := True 148 | end 149 | else if FToken.StringValue = 'false' then 150 | begin 151 | LType := TGraphQLVariableType.BooleanType; 152 | LValue := False 153 | end 154 | else 155 | begin 156 | raise ESyntaxError.Create(Format('String or number expected but identifier [%s] found', [FToken.StringValue]), FToken.LineNumber, FToken.ColumnNumber); 157 | end; 158 | NextToken; 159 | end 160 | else 161 | raise ESyntaxError.Create('String, number or object expected', FToken.LineNumber, FToken.ColumnNumber); 162 | 163 | end; 164 | 165 | Result := TGraphQLArgument.Create(AName, LType, LAttributes, LValue); 166 | end; 167 | 168 | function TGraphQLBuilder.Build: IGraphQL; 169 | begin 170 | inherited; 171 | Result := TGraphQL.Create; 172 | GraphQL(Result); 173 | end; 174 | 175 | constructor TGraphQLBuilder.Create(const ASourceCode: string); 176 | begin 177 | inherited Create(TScanner.CreateFromString(ASourceCode)); 178 | FOwnsScanner := True; 179 | end; 180 | 181 | destructor TGraphQLBuilder.Destroy; 182 | begin 183 | if FOwnsScanner then 184 | FScanner.Free; 185 | inherited; 186 | end; 187 | 188 | // field = [alias ':' ] fieldname [ arguments ] [object] 189 | function TGraphQLBuilder.FieldStatement(AParentField: IGraphQLField): IGraphQLField; 190 | var 191 | LFieldName: string; 192 | LFieldAlias: string; 193 | LValue: IGraphQLValue; 194 | LArguments: IGraphQLList; 195 | LGraphQLField: IGraphQLField; 196 | begin 197 | if FToken.Kind = TTokenKind.Ellipsis then 198 | raise ESyntaxError.Create(Format('Fragments not yet supported', [FToken.StringValue]), FToken.LineNumber, FToken.ColumnNumber); 199 | 200 | Expect(TTokenKind.Identifier, False); 201 | 202 | LFieldName := FToken.StringValue; 203 | LFieldAlias := LFieldName; 204 | 205 | NextToken; 206 | 207 | if FToken.Kind = TTokenKind.Colon then 208 | begin 209 | NextToken; 210 | LFieldName := FToken.StringValue; 211 | NextToken; 212 | end; 213 | 214 | LArguments := TInterfacedList.Create; 215 | if FToken.Kind = TTokenKind.LeftParenthesis then 216 | ArgumentsStatement(LArguments); 217 | 218 | LGraphQLField := TGraphQLField.Create(AParentField, LFieldName, LFieldAlias, LArguments); 219 | 220 | if FToken.Kind = TTokenKind.LeftCurlyBracket then 221 | LValue := ObjectStatement(LGraphQLField as IGraphQLField) 222 | else 223 | LValue := TGraphQLNull.Create; 224 | 225 | (LGraphQLField as TGraphQLField).SetValue(LValue); 226 | 227 | Result := LGraphQLField; 228 | end; 229 | 230 | // TypeName = String | Int | Float | Boolean | ID 231 | function TGraphQLBuilder.TypeName(AGraphQL: IGraphQL): TGraphQLVariableType; 232 | begin 233 | if FToken.IsIdentifier('String') then 234 | Result := TGraphQLVariableType.StringType 235 | else if FToken.IsIdentifier('Int') then 236 | Result := TGraphQLVariableType.IntType 237 | else if FToken.IsIdentifier('Float') then 238 | Result := TGraphQLVariableType.FloatType 239 | else if FToken.IsIdentifier('Boolean') then 240 | Result := TGraphQLVariableType.BooleanType 241 | else if FToken.IsIdentifier('ID') then 242 | Result := TGraphQLVariableType.IdType 243 | else 244 | raise ESyntaxError.Create( 245 | Format('Unknown variable type [%s]', [FToken.StringValue]), 246 | FToken.LineNumber, 247 | FToken.ColumnNumber 248 | ); 249 | 250 | NextToken; 251 | end; 252 | 253 | // Variables = $ identifier : typename [!] [ = defaultValue] 254 | procedure TGraphQLBuilder.Variable(AGraphQL: IGraphQL); 255 | var 256 | LParamName: string; 257 | LParamType: TGraphQLVariableType; 258 | LRequired: Boolean; 259 | LDefaultValue: TValue; 260 | begin 261 | LRequired := False; 262 | LDefaultValue := TValue.Empty; 263 | LParamName := FToken.StringValue; 264 | Expect(TTokenKind.Variable); 265 | Expect(TTokenKind.Colon); 266 | LParamType := TypeName(AGraphQL); 267 | 268 | if FToken.Kind = TTokenKind.IdentifierNot then 269 | begin 270 | LRequired := True; 271 | NextToken; 272 | end; 273 | 274 | if FToken.Kind = TTokenKind.Assignment then 275 | begin 276 | NextToken; 277 | case LParamType of 278 | TGraphQLVariableType.StringType, TGraphQLVariableType.IdType: 279 | begin 280 | Expect(TTokenKind.StringLiteral, False); 281 | LDefaultValue := FToken.StringValue; 282 | end; 283 | TGraphQLVariableType.IntType: 284 | begin 285 | Expect(TTokenKind.IntegerLiteral, False); 286 | LDefaultValue := FToken.IntegerValue; 287 | end; 288 | TGraphQLVariableType.FloatType: 289 | begin 290 | Expect(TTokenKind.FloatLiteral, False); 291 | LDefaultValue := FToken.FloatValue; 292 | end; 293 | TGraphQLVariableType.BooleanType: 294 | begin 295 | Expect(TTokenKind.Identifier, False); 296 | LDefaultValue := StrToBool(FToken.StringValue); 297 | end; 298 | else 299 | begin 300 | raise ESyntaxError.Create( 301 | Format('Unsupported datatype for variable [%s]', [LParamName]), 302 | FToken.LineNumber, 303 | FToken.ColumnNumber 304 | ); 305 | 306 | end; 307 | end; 308 | NextToken; 309 | 310 | end; 311 | 312 | 313 | AGraphQL.AddParam(TGraphQLParam.Create(LParamName, LParamType, LRequired, LDefaultValue)); 314 | end; 315 | 316 | // Variables = [ variable [ variable ... ] ] 317 | procedure TGraphQLBuilder.Variables(AGraphQL: IGraphQL); 318 | begin 319 | if FToken.Kind = TTokenKind.LeftParenthesis then 320 | begin 321 | repeat 322 | NextToken; 323 | Variable(AGraphQL); 324 | until FToken.Kind <> TTokenKind.Comma; 325 | Expect(TTokenKind.RightParenthesis); 326 | end; 327 | end; 328 | 329 | 330 | // GraphQL = 'query' [queryname] [ Variables ] query | query 331 | procedure TGraphQLBuilder.GraphQL(AGraphQL: IGraphQL); 332 | const 333 | DefaultQueryName = 'Anonymous'; 334 | begin 335 | NextToken; 336 | 337 | if FToken.IsIdentifier('query') then 338 | begin 339 | NextToken; 340 | if FToken.IsIdentifier then 341 | begin 342 | AGraphQL.Name := FToken.StringValue; 343 | NextToken; 344 | end 345 | else 346 | AGraphQL.Name := DefaultQueryName; 347 | Variables(AGraphQL); 348 | Query(AGraphQL); 349 | end 350 | else 351 | begin 352 | AGraphQL.Name := DefaultQueryName; 353 | Query(AGraphQL); 354 | end; 355 | 356 | end; 357 | 358 | // object = '{' { field [,] } '}' 359 | function TGraphQLBuilder.ObjectArgumentStatement: TGraphQLArguments; 360 | var 361 | LArguments: TGraphQLArguments; 362 | begin 363 | LArguments := TGraphQLArguments.Create; 364 | try 365 | 366 | Expect(TTokenKind.LeftCurlyBracket); 367 | 368 | (LArguments as IEditableList).Add(ArgumentStamement); 369 | while FToken.Kind = TTokenKind.Comma do 370 | begin 371 | NextToken; 372 | (LArguments as IEditableList).Add(ArgumentStamement); 373 | end; 374 | 375 | Expect(TTokenKind.RightCurlyBracket); 376 | 377 | Result := LArguments; 378 | except 379 | LArguments.Free; 380 | raise; 381 | end; 382 | end; 383 | 384 | // object = '[' { field [,] } ']' 385 | function TGraphQLBuilder.ArrayArgumentStatement: TGraphQLArguments; 386 | var 387 | LArguments: TGraphQLArguments; 388 | LIndex: Integer; 389 | begin 390 | LArguments := TGraphQLArguments.Create; 391 | try 392 | 393 | Expect(TTokenKind.LeftSquareBracket); 394 | LIndex := 0; 395 | 396 | (LArguments as IEditableList).Add(ArrayItemArgumentStatement(LIndex)); 397 | while FToken.Kind = TTokenKind.Comma do 398 | begin 399 | Inc(LIndex); 400 | NextToken; 401 | (LArguments as IEditableList).Add(ArrayItemArgumentStatement(LIndex)); 402 | end; 403 | 404 | Expect(TTokenKind.RightSquareBracket); 405 | 406 | Result := LArguments; 407 | except 408 | LArguments.Free; 409 | raise; 410 | end; 411 | end; 412 | 413 | 414 | function TGraphQLBuilder.ObjectStatement(AParentField: IGraphQLField): IGraphQLObject; 415 | var 416 | LValue: TGraphQLObject; 417 | begin 418 | Expect(TTokenKind.LeftCurlyBracket); 419 | 420 | LValue := TGraphQLObject.Create; 421 | Result := LValue; 422 | 423 | repeat 424 | LValue.Add(FieldStatement(AParentField)); 425 | if FToken.Kind = TTokenKind.Comma then 426 | NextToken; 427 | 428 | until FToken.Kind = TTokenKind.RightCurlyBracket; 429 | 430 | Expect(TTokenKind.RightCurlyBracket); 431 | end; 432 | 433 | // query = '{' objectpair [ [','] objectpair [ [','] objectpair ] ] '}' 434 | procedure TGraphQLBuilder.Query(AGraphQL: IGraphQL); 435 | var 436 | LField: IGraphQLField; 437 | begin 438 | Expect(TTokenKind.LeftCurlyBracket); 439 | 440 | repeat 441 | LField := FieldStatement(nil); 442 | AGraphQL.AddField(LField); 443 | 444 | if FToken.Kind = TTokenKind.Comma then 445 | NextToken; 446 | 447 | until FToken.Kind = TTokenKind.RightCurlyBracket; 448 | 449 | Expect(TTokenKind.RightCurlyBracket); 450 | end; 451 | 452 | end. 453 | -------------------------------------------------------------------------------- /Source/GraphQL.SyntaxAnalysis.Core.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi GraphQL } 4 | { Copyright (c) 2022 Luca Minuti } 5 | { https://github.com/lminuti/graphql } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | unit GraphQL.SyntaxAnalysis.Core; 23 | 24 | interface 25 | 26 | uses 27 | System.Classes, System.SysUtils, System.Rtti, Generics.Collections, 28 | GraphQL.Lexer.Core; 29 | 30 | type 31 | ESyntaxError = class(Exception) 32 | private 33 | FCol: Integer; 34 | FLine: Integer; 35 | public 36 | property Line: Integer read FLine; 37 | property Col: Integer read FCol; 38 | constructor Create(const AMessage: string; ALine, ACol: Integer); 39 | end; 40 | 41 | TReadTokenEvent = procedure (ASender: TObject; AToken: TToken) of object; 42 | 43 | TSyntaxAnalysis = class(TObject) 44 | private 45 | FTokenQueue: TQueue; 46 | FOnReadToken: TReadTokenEvent; 47 | protected 48 | FScanner: TScanner; 49 | FToken: TToken; 50 | procedure Expect(ATokenKind: TTokenKind; MoveNext: Boolean = True); 51 | procedure NextToken; virtual; 52 | function Lookahead: TToken; virtual; 53 | public 54 | property OnReadToken: TReadTokenEvent read FOnReadToken write FOnReadToken; 55 | 56 | constructor Create(AScanner: TScanner); virtual; 57 | destructor Destroy; override; 58 | end; 59 | 60 | implementation 61 | 62 | { ESyntaxError } 63 | 64 | constructor ESyntaxError.Create(const AMessage: string; ALine, ACol: Integer); 65 | begin 66 | FLine := ALine; 67 | FCol := ACol; 68 | inherited CreateFmt(AMessage + ' at line %d', [ALine]); 69 | end; 70 | 71 | { TSyntaxAnalysis } 72 | 73 | constructor TSyntaxAnalysis.Create(AScanner: TScanner); 74 | begin 75 | inherited Create; 76 | FScanner := AScanner; 77 | FTokenQueue := TQueue.Create; 78 | end; 79 | 80 | procedure TSyntaxAnalysis.NextToken; 81 | begin 82 | if FTokenQueue.Count > 0 then 83 | FToken := FTokenQueue.Dequeue 84 | else 85 | FToken := FScanner.NextToken; 86 | 87 | if Assigned(FOnReadToken) then 88 | FOnReadToken(Self, FToken); 89 | end; 90 | 91 | function TSyntaxAnalysis.Lookahead: TToken; 92 | begin 93 | Result := FScanner.NextToken; 94 | FTokenQueue.Enqueue(Result); 95 | end; 96 | 97 | destructor TSyntaxAnalysis.Destroy; 98 | begin 99 | FTokenQueue.Free; 100 | inherited; 101 | end; 102 | 103 | procedure TSyntaxAnalysis.Expect(ATokenKind: TTokenKind; MoveNext: Boolean); 104 | begin 105 | if ATokenKind <> FToken.Kind then 106 | raise ESyntaxError.Create( 107 | Format('Expected [%s] but found [%s]', [KindToString(ATokenKind), KindToString(FToken.Kind)]), 108 | FToken.LineNumber, 109 | FToken.ColumnNumber 110 | ); 111 | if MoveNext then 112 | NextToken; 113 | end; 114 | 115 | end. 116 | -------------------------------------------------------------------------------- /Source/GraphQL.Utils.JSON.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi GraphQL } 4 | { Copyright (c) 2022 Luca Minuti } 5 | { https://github.com/lminuti/graphql } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | unit GraphQL.Utils.JSON; 23 | 24 | interface 25 | 26 | uses 27 | System.SysUtils, System.Classes, System.StrUtils, System.JSON; 28 | 29 | type 30 | TJSONHelper = class(TObject) 31 | public 32 | class function PrettyPrint(AJSONValue: TJSONValue): string; overload; static; 33 | class function PrettyPrint(const AJSONString: string): string; overload; static; 34 | class function QuoteString(const AValue: string): string; static; 35 | end; 36 | 37 | implementation 38 | 39 | class function TJSONHelper.QuoteString(const AValue: string): string; 40 | begin 41 | Result := '"' + AnsiReplaceStr(AValue, '"', '\"') + '"'; 42 | end; 43 | 44 | class function TJSONHelper.PrettyPrint(AJSONValue: TJSONValue): string; 45 | var 46 | LJSONString: string; 47 | begin 48 | LJSONString := AJSONValue.ToString; 49 | Result := TJSONHelper.PrettyPrint(LJSONString); 50 | end; 51 | 52 | class function TJSONHelper.PrettyPrint(const AJSONString: string): string; 53 | var 54 | LPrevousChar: Char; 55 | LChar: Char; 56 | LOffset: Integer; 57 | LInString: Boolean; 58 | 59 | function Spaces(AOffset: Integer): string; 60 | begin 61 | Result := StringOfChar(#32, AOffset * 2); 62 | end; 63 | 64 | begin 65 | Result := ''; 66 | LOffset := 0; 67 | LPrevousChar := #0; 68 | LInString := False; 69 | for LChar in AJSONString do 70 | begin 71 | if (LChar = '"') and (LPrevousChar <> '\') then 72 | begin 73 | LInString := not LInString; 74 | Result := Result + LChar; 75 | end 76 | else if LInString then 77 | begin 78 | Result := Result + LChar; 79 | end 80 | else if LChar = '{' then 81 | begin 82 | Inc(LOffset); 83 | Result := Result + LChar; 84 | Result := Result + sLineBreak; 85 | Result := Result + Spaces(LOffset); 86 | end 87 | else if LChar = '}' then 88 | begin 89 | Dec(LOffset); 90 | Result := Result + sLineBreak; 91 | Result := Result + Spaces(LOffset); 92 | Result := Result + LChar; 93 | end 94 | else if LChar = ',' then 95 | begin 96 | Result := Result + LChar; 97 | Result := Result + sLineBreak; 98 | Result := Result + Spaces(LOffset); 99 | end 100 | else if LChar = '[' then 101 | begin 102 | Inc(LOffset); 103 | Result := Result + LChar; 104 | Result := Result + sLineBreak; 105 | Result := Result + Spaces(LOffset); 106 | end 107 | else if LChar = ']' then 108 | begin 109 | Dec(LOffset); 110 | Result := Result + sLineBreak; 111 | Result := Result + Spaces(LOffset); 112 | Result := Result + LChar; 113 | end 114 | else 115 | Result := Result + LChar; 116 | LPrevousChar := LChar; 117 | end; 118 | end; 119 | 120 | end. 121 | -------------------------------------------------------------------------------- /Source/GraphQL.Utils.Rtti.pas: -------------------------------------------------------------------------------- 1 | {******************************************************************************} 2 | { } 3 | { Delphi GraphQL } 4 | { Copyright (c) 2022 Luca Minuti } 5 | { https://github.com/lminuti/graphql } 6 | { } 7 | {******************************************************************************} 8 | { } 9 | { Licensed under the Apache License, Version 2.0 (the "License"); } 10 | { you may not use this file except in compliance with the License. } 11 | { You may obtain a copy of the License at } 12 | { } 13 | { http://www.apache.org/licenses/LICENSE-2.0 } 14 | { } 15 | { Unless required by applicable law or agreed to in writing, software } 16 | { distributed under the License is distributed on an "AS IS" BASIS, } 17 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. } 18 | { See the License for the specific language governing permissions and } 19 | { limitations under the License. } 20 | { } 21 | {******************************************************************************} 22 | 23 | unit GraphQL.Utils.Rtti; 24 | 25 | interface 26 | 27 | uses 28 | System.SysUtils, System.Classes, System.Rtti, System.TypInfo; 29 | 30 | type 31 | 32 | TRttiHelper = class 33 | private 34 | class var FContext: TRttiContext; 35 | public 36 | // TRttiObject helpers functions 37 | class function FindAttribute(AClass: TClass): T; overload; static; 38 | 39 | class function FindAttribute(AType: TRttiObject): T; overload; static; 40 | 41 | class function HasAttribute(AClass: TClass): Boolean; overload; static; 42 | 43 | class function HasAttribute(ARttiObj: TRttiObject): Boolean; overload; static; 44 | 45 | class function HasAttribute( 46 | ARttiObj: TRttiObject; const ADoSomething: TProc): Boolean; overload; static; 47 | 48 | class function ForEachAttribute( 49 | ARttiObj: TRttiObject; const ADoSomething: TProc): Integer; overload; static; 50 | 51 | // TRttiType helpers functions 52 | class function ForEachMethodWithAttribute( 53 | ARttiType: TRttiType; const ADoSomething: TFunc): Integer; static; 54 | 55 | class function ForEachFieldWithAttribute( 56 | ARttiType: TRttiType; const ADoSomething: TFunc): Integer; overload; static; 57 | 58 | class function ForEachPropertyWithAttribute( 59 | ARttiType: TRttiType; const ADoSomething: TFunc): Integer; overload; static; 60 | 61 | class function IsDynamicArrayOf(ARttiType: TRttiType; 62 | const AAllowInherithance: Boolean = True): Boolean; overload; static; 63 | 64 | class function IsDynamicArrayOf(ARttiType: TRttiType; const AClass: TClass; 65 | const AAllowInherithance: Boolean = True): Boolean; overload; static; 66 | 67 | class function IsObjectOfType(ARttiType: TRttiType; 68 | const AAllowInherithance: Boolean = True): Boolean; overload; static; 69 | 70 | class function IsObjectOfType(ARttiType: TRttiType; const AClass: TClass; 71 | const AAllowInherithance: Boolean = True): Boolean; overload; static; 72 | 73 | class function IsInterfaceOfType(ARttiType: TRttiType; const IID: TGUID; 74 | const AAllowInherithance: Boolean = True): Boolean; overload; static; 75 | 76 | // Create new value data 77 | class function CreateNewValue(AType: TRttiType): TValue; static; 78 | 79 | // Create instance of class with parameterless constructor 80 | class function CreateInstanceValue(AType: TRttiType): TValue; overload; 81 | 82 | // Create instance of class with parameterless constructor 83 | class function CreateInstance(AClass: TClass): TObject; overload; 84 | class function CreateInstance(AType: TRttiType): TObject; overload; 85 | class function CreateInstance(const ATypeName: string): TObject; overload; 86 | 87 | // Create instance of class with one string parameter 88 | class function CreateInstance(AClass: TClass; const AValue: string): TObject; overload; 89 | class function CreateInstance(AType: TRttiType; const AValue: string): TObject; overload; 90 | class function CreateInstance(const ATypeName, AValue: string): TObject; overload; 91 | 92 | // Create instance of class with an array of TValue 93 | class function CreateInstance(AClass: TClass; const Args: array of TValue): TObject; overload; 94 | class function CreateInstance(AType: TRttiType; const Args: array of TValue): TObject; overload; 95 | class function CreateInstance(const ATypeName: string; const Args: array of TValue): TObject; overload; 96 | 97 | // Rtti general helper functions 98 | class function IfHasAttribute(AInstance: TObject): Boolean; overload; 99 | class function IfHasAttribute(AInstance: TObject; const ADoSomething: TProc): Boolean; overload; 100 | 101 | class function ForEachAttribute(AInstance: TObject; const ADoSomething: TProc): Integer; overload; 102 | 103 | class function ForEachFieldWithAttribute(AInstance: TObject; const ADoSomething: TFunc): Integer; overload; 104 | class function ForEachField(AInstance: TObject; const ADoSomething: TFunc): Integer; 105 | 106 | class function GetType(AObject: TRttiObject): TRttiType; 107 | 108 | class constructor Create; 109 | class destructor Destroy; 110 | 111 | class property Context: TRttiContext read FContext; 112 | end; 113 | 114 | implementation 115 | 116 | uses 117 | Generics.Collections, 118 | System.DateUtils; 119 | 120 | { TRttiHelper } 121 | 122 | class function TRttiHelper.CreateNewValue(AType: TRttiType): TValue; 123 | var 124 | LAllocatedMem: Pointer; 125 | begin 126 | case AType.TypeKind of 127 | tkInteger: Result := TValue.From(0); 128 | tkInt64: Result := TValue.From(0); 129 | tkChar: Result := TValue.From(#0); 130 | tkWChar: Result := TValue.From(#0); 131 | tkFloat: Result := TValue.From(0); 132 | tkString: Result := TValue.From(''); 133 | tkWString: Result := TValue.From(''); 134 | tkLString: Result := TValue.From(''); 135 | tkUString: Result := TValue.From(''); 136 | tkClass: Result := CreateInstance(AType); 137 | tkRecord: 138 | begin 139 | LAllocatedMem := AllocMem(AType.TypeSize); 140 | try 141 | TValue.Make(LAllocatedMem, AType.Handle, Result); 142 | finally 143 | FreeMem(LAllocatedMem); 144 | end; 145 | end; 146 | else 147 | raise Exception.CreateFmt('Error creating type', [AType.Name]); 148 | end; 149 | end; 150 | 151 | class destructor TRttiHelper.Destroy; 152 | begin 153 | FContext.Free; 154 | end; 155 | 156 | class function TRttiHelper.CreateInstance(AClass: TClass): TObject; 157 | var 158 | LType: TRttiType; 159 | begin 160 | LType := FContext.GetType(AClass); 161 | Result := CreateInstanceValue(LType).AsObject; 162 | end; 163 | 164 | class function TRttiHelper.CreateInstance(AType: TRttiType): TObject; 165 | begin 166 | Result := CreateInstanceValue(AType).AsObject; 167 | end; 168 | 169 | class function TRttiHelper.CreateInstance(const ATypeName: string): TObject; 170 | var 171 | LType: TRttiType; 172 | begin 173 | LType := Context.FindType(ATypeName); 174 | Result := CreateInstanceValue(LType).AsObject; 175 | end; 176 | 177 | class function TRttiHelper.CreateInstance(AClass: TClass; const AValue: string): TObject; 178 | var 179 | LType: TRttiType; 180 | begin 181 | LType := FContext.GetType(AClass); 182 | Result := CreateInstance(LType, AValue); 183 | end; 184 | 185 | class function TRttiHelper.CreateInstance(AType: TRttiType; 186 | const AValue: string): TObject; 187 | var 188 | LMethod: TRttiMethod; 189 | LMetaClass: TClass; 190 | begin 191 | Result := nil; 192 | if Assigned(AType) then 193 | begin 194 | for LMethod in AType.GetMethods do 195 | begin 196 | if LMethod.HasExtendedInfo and LMethod.IsConstructor then 197 | begin 198 | if Length(LMethod.GetParameters) = 1 then 199 | begin 200 | if LMethod.GetParameters[0].ParamType.TypeKind in [tkLString, tkUString, tkWString, tkString] then 201 | begin 202 | LMetaClass := AType.AsInstance.MetaclassType; 203 | Exit(LMethod.Invoke(LMetaClass, [AValue]).AsObject); 204 | end; 205 | end; 206 | end; 207 | end; 208 | end; 209 | end; 210 | 211 | class function TRttiHelper.CreateInstance(const ATypeName, AValue: string): TObject; 212 | var 213 | LType: TRttiType; 214 | begin 215 | LType := Context.FindType(ATypeName); 216 | Result := CreateInstance(LType, AValue); 217 | end; 218 | 219 | class function TRttiHelper.CreateInstanceValue(AType: TRttiType): TValue; 220 | var 221 | LMethod: TRTTIMethod; 222 | LMetaClass: TClass; 223 | begin 224 | Result := nil; 225 | if Assigned(AType) then 226 | for LMethod in AType.GetMethods do 227 | begin 228 | if LMethod.HasExtendedInfo and LMethod.IsConstructor then 229 | begin 230 | if Length(LMethod.GetParameters) = 0 then 231 | begin 232 | LMetaClass := AType.AsInstance.MetaclassType; 233 | Exit(LMethod.Invoke(LMetaClass, [])); 234 | end; 235 | end; 236 | end; 237 | end; 238 | 239 | class function TRttiHelper.FindAttribute(AClass: TClass): T; 240 | begin 241 | Result := FindAttribute(Context.GetType(AClass)); 242 | end; 243 | 244 | class function TRttiHelper.ForEachAttribute(AInstance: TObject; 245 | const ADoSomething: TProc): Integer; 246 | var 247 | LContext: TRttiContext; 248 | LType: TRttiType; 249 | begin 250 | Result := 0; 251 | LType := LContext.GetType(AInstance.ClassType); 252 | if Assigned(LType) then 253 | Result := TRttiHelper.ForEachAttribute(LType, ADoSomething); 254 | end; 255 | 256 | class function TRttiHelper.ForEachField(AInstance: TObject; 257 | const ADoSomething: TFunc): Integer; 258 | var 259 | LContext: TRttiContext; 260 | LField: TRttiField; 261 | LType: TRttiType; 262 | LBreak: Boolean; 263 | begin 264 | Result := 0; 265 | LType := LContext.GetType(AInstance.ClassType); 266 | for LField in LType.GetFields do 267 | begin 268 | LBreak := False; 269 | 270 | if Assigned(ADoSomething) then 271 | begin 272 | if not ADoSomething(LField) then 273 | LBreak := True 274 | else 275 | Inc(Result); 276 | end; 277 | 278 | if LBreak then 279 | Break; 280 | end; 281 | end; 282 | 283 | class function TRttiHelper.ForEachFieldWithAttribute(AInstance: TObject; 284 | const ADoSomething: TFunc): Integer; 285 | var 286 | LContext: TRttiContext; 287 | LType: TRttiType; 288 | begin 289 | Result := 0; 290 | LType := LContext.GetType(AInstance.ClassType); 291 | if Assigned(LType) then 292 | Result := TRttiHelper.ForEachFieldWithAttribute(LType, ADoSomething); 293 | end; 294 | 295 | class function TRttiHelper.IfHasAttribute(AInstance: TObject): Boolean; 296 | begin 297 | Result := TRttiHelper.IfHasAttribute(AInstance, nil); 298 | end; 299 | 300 | class function TRttiHelper.IfHasAttribute(AInstance: TObject; 301 | const ADoSomething: TProc): Boolean; 302 | var 303 | LContext: TRttiContext; 304 | LType: TRttiType; 305 | begin 306 | Result := False; 307 | LType := LContext.GetType(AInstance.ClassType); 308 | if Assigned(LType) then 309 | Result := TRttiHelper.HasAttribute(LType, ADoSomething); 310 | end; 311 | 312 | class function TRttiHelper.ForEachAttribute(ARttiObj: TRttiObject; 313 | const ADoSomething: TProc): Integer; 314 | var 315 | LAttribute: TCustomAttribute; 316 | begin 317 | Result := 0; 318 | for LAttribute in ARttiObj.GetAttributes do 319 | begin 320 | if LAttribute.InheritsFrom(TClass(T)) then 321 | begin 322 | if Assigned(ADoSomething) then 323 | ADoSomething(T(LAttribute)); 324 | Inc(Result); 325 | end; 326 | end; 327 | end; 328 | 329 | class function TRttiHelper.HasAttribute(ARttiObj: TRttiObject): Boolean; 330 | begin 331 | Result := HasAttribute(ARttiObj, nil); 332 | end; 333 | 334 | class function TRttiHelper.HasAttribute(ARttiObj: TRttiObject; const 335 | ADoSomething: TProc): Boolean; 336 | var 337 | LAttribute: TCustomAttribute; 338 | begin 339 | Result := False; 340 | for LAttribute in ARttiObj.GetAttributes do 341 | begin 342 | if LAttribute.InheritsFrom(TClass(T)) then 343 | begin 344 | Result := True; 345 | 346 | if Assigned(ADoSomething) then 347 | ADoSomething(T(LAttribute)); 348 | 349 | Break; 350 | end; 351 | end; 352 | end; 353 | 354 | class function TRttiHelper.ForEachFieldWithAttribute(ARttiType: TRttiType; 355 | const ADoSomething: TFunc): Integer; 356 | var 357 | LField: TRttiField; 358 | LBreak: Boolean; 359 | begin 360 | for LField in ARttiType.GetFields do 361 | begin 362 | LBreak := False; 363 | if TRttiHelper.HasAttribute(LField, 364 | procedure (AAttrib: T) 365 | begin 366 | if Assigned(ADoSomething) then 367 | begin 368 | if not ADoSomething(LField, AAttrib) then 369 | LBreak := True; 370 | end; 371 | end 372 | ) 373 | then 374 | Inc(Result); 375 | 376 | if LBreak then 377 | Break; 378 | end; 379 | end; 380 | 381 | class function TRttiHelper.ForEachMethodWithAttribute(ARttiType: TRttiType; 382 | const ADoSomething: TFunc): Integer; 383 | var 384 | LMethod: TRttiMethod; 385 | LBreak: Boolean; 386 | begin 387 | Result := 0; 388 | for LMethod in ARttiType.GetMethods do 389 | begin 390 | LBreak := False; 391 | if TRttiHelper.HasAttribute(LMethod, 392 | procedure (AAttrib: T) 393 | begin 394 | if Assigned(ADoSomething) then 395 | begin 396 | if not ADoSomething(LMethod, AAttrib) then 397 | LBreak := True; 398 | end; 399 | end 400 | ) 401 | then 402 | Inc(Result); 403 | 404 | if LBreak then 405 | Break; 406 | end; 407 | end; 408 | 409 | class function TRttiHelper.ForEachPropertyWithAttribute(ARttiType: TRttiType; 410 | const ADoSomething: TFunc): Integer; 411 | var 412 | LProperty: TRttiProperty; 413 | LBreak: Boolean; 414 | begin 415 | Result := 0; 416 | for LProperty in ARttiType.GetProperties do 417 | begin 418 | LBreak := False; 419 | if TRttiHelper.HasAttribute(LProperty, 420 | procedure (AAttrib: T) 421 | begin 422 | if Assigned(ADoSomething) then 423 | begin 424 | if not ADoSomething(LProperty, AAttrib) then 425 | LBreak := True; 426 | end; 427 | end 428 | ) 429 | then 430 | Inc(Result); 431 | 432 | if LBreak then 433 | Break; 434 | end; 435 | end; 436 | 437 | class function TRttiHelper.GetType(AObject: TRttiObject): TRttiType; 438 | begin 439 | if AObject is TRttiParameter then 440 | Result := TRttiParameter(AObject).ParamType 441 | else if AObject is TRttiField then 442 | Result := TRttiField(AObject).FieldType 443 | else if AObject is TRttiProperty then 444 | Result := TRttiProperty(AObject).PropertyType 445 | else if AObject is TRttiManagedField then 446 | Result := TRttiManagedField(AObject).FieldType 447 | else 448 | raise Exception.Create('Object doesn''t have a type'); 449 | end; 450 | 451 | class function TRttiHelper.HasAttribute(AClass: TClass): Boolean; 452 | begin 453 | Result := HasAttribute(Context.GetType(AClass)); 454 | end; 455 | 456 | class function TRttiHelper.IsDynamicArrayOf(ARttiType: TRttiType; 457 | const AClass: TClass; const AAllowInherithance: Boolean): Boolean; 458 | begin 459 | Result := False; 460 | if ARttiType is TRttiDynamicArrayType then 461 | Result := TRttiHelper.IsObjectOfType( 462 | TRttiDynamicArrayType(ARttiType).ElementType, AClass, AAllowInherithance); 463 | end; 464 | 465 | class function TRttiHelper.IsDynamicArrayOf(ARttiType: TRttiType; 466 | const AAllowInherithance: Boolean): Boolean; 467 | begin 468 | Result := TRttiHelper.IsDynamicArrayOf(ARttiType, TClass(T), AAllowInherithance); 469 | end; 470 | 471 | class function TRttiHelper.IsInterfaceOfType(ARttiType: TRttiType; 472 | const IID: TGUID; const AAllowInherithance: Boolean): Boolean; 473 | var 474 | LInterfaceType: TRttiInterfaceType; 475 | begin 476 | Result := False; 477 | if ARttiType is TRttiInterfaceType then 478 | begin 479 | LInterfaceType := TRttiInterfaceType(ARttiType); 480 | repeat 481 | if LInterfaceType.GUID = IID then 482 | Exit(True); 483 | LInterfaceType := LInterfaceType.BaseType; 484 | until (LInterfaceType = nil) or (not AAllowInherithance); 485 | end; 486 | end; 487 | 488 | class function TRttiHelper.IsObjectOfType(ARttiType: TRttiType; 489 | const AClass: TClass; const AAllowInherithance: Boolean): Boolean; 490 | begin 491 | Result := False; 492 | if ARttiType is TRttiInstanceType then 493 | begin 494 | if AAllowInherithance then 495 | Result := TRttiInstanceType(ARttiType).MetaclassType.InheritsFrom(AClass) 496 | else 497 | Result := TRttiInstanceType(ARttiType).MetaclassType = AClass; 498 | end; 499 | end; 500 | 501 | class function TRttiHelper.IsObjectOfType(ARttiType: TRttiType; 502 | const AAllowInherithance: Boolean): Boolean; 503 | begin 504 | Result := TRttiHelper.IsObjectOfType(ARttiType, TClass(T), AAllowInherithance); 505 | end; 506 | 507 | class function TRttiHelper.FindAttribute(AType: TRttiObject): T; 508 | var 509 | LAttribute: TCustomAttribute; 510 | begin 511 | Result := nil; 512 | for LAttribute in AType.GetAttributes do 513 | begin 514 | if LAttribute.InheritsFrom(TClass(T)) then 515 | begin 516 | Result := LAttribute as T; 517 | 518 | Break; 519 | end; 520 | end; 521 | end; 522 | 523 | class function TRttiHelper.CreateInstance(AClass: TClass; 524 | const Args: array of TValue): TObject; 525 | var 526 | LType: TRttiType; 527 | begin 528 | LType := FContext.GetType(AClass); 529 | Result := CreateInstance(LType, Args); 530 | end; 531 | 532 | class function TRttiHelper.CreateInstance(AType: TRttiType; 533 | const Args: array of TValue): TObject; 534 | var 535 | LMethod: TRttiMethod; 536 | LMetaClass: TClass; 537 | begin 538 | Result := nil; 539 | if Assigned(AType) then 540 | begin 541 | for LMethod in AType.GetMethods do 542 | begin 543 | if LMethod.HasExtendedInfo and LMethod.IsConstructor then 544 | begin 545 | if Length(LMethod.GetParameters) = Length(Args) then 546 | begin 547 | LMetaClass := AType.AsInstance.MetaclassType; 548 | Exit(LMethod.Invoke(LMetaClass, Args).AsObject); 549 | end; 550 | end; 551 | end; 552 | end; 553 | if not Assigned(Result) then 554 | raise Exception.CreateFmt('TRttiHelper.CreateInstance: can''t create object [%s]', [AType.Name]); 555 | end; 556 | 557 | class constructor TRttiHelper.Create; 558 | begin 559 | FContext := TRttiContext.Create; 560 | end; 561 | 562 | class function TRttiHelper.CreateInstance(const ATypeName: string; 563 | const Args: array of TValue): TObject; 564 | var 565 | LType: TRttiType; 566 | begin 567 | LType := Context.FindType(ATypeName); 568 | Result := CreateInstance(LType, Args); 569 | end; 570 | 571 | end. 572 | -------------------------------------------------------------------------------- /notes.txt: -------------------------------------------------------------------------------- 1 | RollDice: 2 | https://graphql.org/graphql-js/passing-arguments/ 3 | 4 | https://graphql.org/learn/queries/ --------------------------------------------------------------------------------