├── .gitignore ├── LICENSE ├── MyriadTesting ├── Example │ ├── Example.fsproj │ ├── Generated.fs │ ├── Model.fs │ └── Program.fs ├── JsonPlugin.gif ├── JsonPlugin │ ├── JsonPlugin.fsproj │ ├── Library.fs │ ├── Types.fs │ ├── Util.fs │ └── build.props └── MyriadTesting.sln └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | .ionide 2 | .vs 3 | obj 4 | bin -------------------------------------------------------------------------------- /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 | -------------------------------------------------------------------------------- /MyriadTesting/Example/Example.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | Exe 5 | netcoreapp3.0 6 | 7 | 8 | 9 | 10 | 11 | Model.fs 12 | Test 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | -------------------------------------------------------------------------------- /MyriadTesting/Example/Generated.fs: -------------------------------------------------------------------------------- 1 | //------------------------------------------------------------------------------ 2 | // This code was generated by myriad. 3 | // Changes to this file will be lost when the code is regenerated. 4 | //------------------------------------------------------------------------------ 5 | namespace rec Test 6 | 7 | 8 | namespace Test 9 | 10 | open JsonPlugin.Types 11 | 12 | type Encoder = 13 | static member inline Encode(str : string) = JsonValue.String(str) 14 | static member inline Encode(value : bool) = JsonValue.Boolean(value) 15 | static member inline Encode(list : #array<'a>) = 16 | JsonValue.Array(Seq.toArray (list |> Seq.map (fun element -> Encoder.Encode element))) 17 | static member inline Encode(number : int16) = JsonValue.Number(decimal (number)) 18 | static member inline Encode(number : int32) = JsonValue.Number(decimal (number)) 19 | static member inline Encode(number : int64) = JsonValue.Number(decimal (number)) 20 | static member inline Encode(number : uint16) = JsonValue.Number(decimal (number)) 21 | static member inline Encode(number : uint32) = JsonValue.Number(decimal (number)) 22 | static member inline Encode(number : uint64) = JsonValue.Number(decimal (number)) 23 | static member inline Encode(number : float) = JsonValue.Number(decimal (number)) 24 | static member inline Encode(number : float32) = JsonValue.Number(decimal (number)) 25 | static member inline Encode(number : byte) = JsonValue.Number(decimal (number)) 26 | static member inline Encode(number : sbyte) = JsonValue.Number(decimal (number)) 27 | 28 | static member inline Encode(somerecord : Model.SomeRecord) = 29 | JsonValue.Record([| "foo", Encoder.Encode(somerecord.foo) 30 | "bar", Encoder.Encode(somerecord.bar) 31 | "spam", Encoder.Encode(somerecord.spam) |]) 32 | 33 | static member inline Encode(somerecord2 : Model.SomeRecord2) = 34 | JsonValue.Record([| "foo", Encoder.Encode(somerecord2.foo) |]) 35 | 36 | static member inline Encode(somerecord3 : Model.SomeRecord3) = 37 | JsonValue.Record([| "foo", Encoder.Encode(somerecord3.foo) 38 | "bar", Encoder.Encode(somerecord3.bar) |]) 39 | 40 | static member inline Encode(someunion : Model.SomeUnion) = 41 | JsonValue.Record [| match someunion with 42 | | Model.SomeUnion.CaseA a -> "CaseA", JsonValue.Record([| "a", Encoder.Encode(a) |]) 43 | | Model.SomeUnion.CaseB value -> 44 | "CaseB", JsonValue.Record([| "value", Encoder.Encode(value) |]) 45 | | Model.SomeUnion.CaseC b -> "CaseC", JsonValue.Record([| "b", Encoder.Encode(b) |]) 46 | | Model.SomeUnion.CaseE _ -> "CaseE", JsonValue.Record([||]) |] 47 | -------------------------------------------------------------------------------- /MyriadTesting/Example/Model.fs: -------------------------------------------------------------------------------- 1 | module Model 2 | 3 | [] 4 | type SomeRecord = 5 | { foo: int 6 | bar: string 7 | spam: float } 8 | 9 | [] 10 | type SomeRecord2 = 11 | { foo: SomeRecord } 12 | 13 | [] 14 | type SomeRecord3 = 15 | { foo: SomeRecord 16 | bar: SomeRecord2 } 17 | 18 | [] 19 | type SomeUnion = 20 | | CaseA of a: int 21 | | CaseB of value: SomeRecord 22 | | CaseC of b: bool 23 | //| CaseD of arr: bool array 24 | | CaseE -------------------------------------------------------------------------------- /MyriadTesting/Example/Program.fs: -------------------------------------------------------------------------------- 1 | // Learn more about F# at http://fsharp.org 2 | 3 | open System 4 | open Model 5 | 6 | (* 7 | static member inline Encode(list : #array< ^c>) = 8 | let inline call2 (a: ^a, b: ^b) = ((^a or ^b or ^c) : (static member Encode: ^b -> JsonValue)(b)) 9 | [| for element in list -> call2 (Unchecked.defaultof, element) |] 10 | |> JsonValue.Array 11 | *) 12 | 13 | open JsonPlugin.Types 14 | 15 | let rec jsonToString json = 16 | match json with 17 | | JsonValue.Record fields -> 18 | seq { 19 | for (fieldName, fieldValue) in fields -> sprintf "\"%s\":%s" fieldName (jsonToString fieldValue) 20 | } |> String.concat "," 21 | |> sprintf "{%s}" 22 | | JsonValue.Number number -> sprintf "%f" number 23 | | JsonValue.String str -> sprintf "%A" str 24 | | JsonValue.Null -> "null" 25 | | JsonValue.Boolean b -> sprintf "%A" b 26 | //| JsonValue.Array arr -> "" 27 | 28 | [] 29 | let main argv = 30 | printfn "Hello World from F#!" 31 | { foo = 1 32 | bar = "" 33 | spam = 2. } 34 | |> Test.Encoder.Encode 35 | |> jsonToString 36 | |> printfn "%s" 37 | SomeUnion.CaseA 10 38 | |> Test.Encoder.Encode 39 | |> jsonToString 40 | |> printfn "%s" 41 | Console.ReadKey() |> ignore 42 | 0 // return an integer exit code 43 | -------------------------------------------------------------------------------- /MyriadTesting/JsonPlugin.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/realvictorprm/FSharpCompileTimeJson/616458e924c2505680bcdbf1c053109c29d7a0d7/MyriadTesting/JsonPlugin.gif -------------------------------------------------------------------------------- /MyriadTesting/JsonPlugin/JsonPlugin.fsproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | netstandard2.1 5 | true 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | true 22 | %(Identity) 23 | true 24 | 25 | 26 | 27 | -------------------------------------------------------------------------------- /MyriadTesting/JsonPlugin/Library.fs: -------------------------------------------------------------------------------- 1 | namespace JsonPlugin 2 | 3 | open System 4 | open Myriad.Core 5 | open Microsoft.FSharp.Compiler.Ast 6 | open Microsoft.FSharp.Compiler 7 | open FsAst 8 | 9 | type CompileTimeJsonEncodingAttribute() = inherit Attribute() 10 | [] 11 | module Util = 12 | let getAttributeName (attr: SynAttribute) = attr.TypeName.AsString 13 | let yes = true 14 | let no = false 15 | 16 | type WhatIsThat = 17 | | ItsAnUnion of moduleIdent: LongIdent * typeIdent: LongIdent * unionCases: SynUnionCases 18 | | ItsAnRecord of moduleIdent: LongIdent * typeIdent: LongIdent * recordFields: SynFields 19 | 20 | [] 21 | type Example1Gen() = 22 | let mkUncurriedSimpleExprCall objectIdent expr = 23 | SynExpr.CreateApp( 24 | SynExpr.CreateLongIdent( 25 | false, 26 | objectIdent, 27 | None 28 | ), SynExpr.CreateParen(expr)) 29 | let mkUncurriedSimpleCall objectIdent arguments = 30 | SynExpr.CreateApp( 31 | SynExpr.CreateLongIdent( 32 | false, 33 | objectIdent, 34 | None 35 | ), 36 | match arguments with 37 | | [] -> SynExpr.CreateConst SynConst.Unit 38 | | _ -> 39 | SynExpr.CreateParen( 40 | match arguments with 41 | | [ arg ] -> 42 | SynExpr.CreateLongIdent( 43 | false, 44 | arg, 45 | None 46 | ) 47 | | _ -> 48 | arguments 49 | |> List.map(fun arg -> 50 | SynExpr.CreateLongIdent( 51 | false, 52 | arg, 53 | None 54 | )) 55 | |> SynExpr.CreateTuple 56 | ) 57 | ) 58 | let mkEncoder members = 59 | SynModuleDecl.CreateType([Ident.Create "Encoder"] |> SynComponentInfoRcd.Create, members) 60 | //let mkMemberBinding name parameters expr = 61 | // SynBinding.Binding( 62 | // SynAccess.Public |> Some, 63 | // SynBindingKind.NormalBinding, 64 | // no, 65 | // no, 66 | // [], 67 | // PreXmlDoc.Empty, 68 | // SynValData(Some { 69 | // IsInstance = false 70 | // IsDispatchSlot = false 71 | // IsOverrideOrExplicitImpl = false 72 | // IsFinal = false 73 | // MemberKind = MemberKind.Member }, 74 | // SynValInfo( 75 | // [parameters |> List.map(fun (paramName, _) -> SynArgInfo ([],false, Ident.Create paramName |> Some))], 76 | // SynArgInfo ([],false,None)), 77 | // None), 78 | // SynPat.LongIdent( 79 | // name, 80 | // None, None, 81 | // SynConstructorArgs.Pats([ 82 | // SynPat.Paren( 83 | // SynPat.Typed( 84 | // SynPat.Named( 85 | // SynPat.Wild(Range.rangeStartup), 86 | // Ident.Create paramName, false, None, Range.rangeStartup 87 | // ), 88 | // SynType.LongIdent(LongIdentWithDots.CreateString typ), 89 | // Range.rangeStartup 90 | // ), 91 | // Range.rangeStartup 92 | // ) 93 | // ]), 94 | // None, Range.rangeStartup 95 | // ), 96 | // None, 97 | // expr, 98 | // Range.rangeStartup, 99 | // NoSequencePointAtInvisibleBinding 100 | // ) 101 | let mkEncodeMemberBindingSpecialType paramName typ expr = 102 | SynBinding.Binding( 103 | None, 104 | SynBindingKind.NormalBinding, 105 | yes, 106 | no, 107 | [], 108 | PreXmlDoc.Empty, 109 | SynValData(Some { 110 | IsInstance = false 111 | IsDispatchSlot = false 112 | IsOverrideOrExplicitImpl = false 113 | IsFinal = false 114 | MemberKind = MemberKind.Member }, 115 | SynValInfo( 116 | [[SynArgInfo ([],false, Ident.Create paramName |> Some)]], 117 | SynArgInfo ([],false,None)), 118 | None), 119 | SynPat.LongIdent( 120 | LongIdentWithDots.CreateString "Encode", 121 | None, None, 122 | SynConstructorArgs.Pats([ 123 | SynPat.Paren( 124 | SynPat.Typed( 125 | SynPat.Named( 126 | SynPat.Wild(Range.rangeStartup), 127 | Ident.Create paramName, false, None, Range.rangeStartup 128 | ), 129 | typ, 130 | Range.rangeStartup 131 | ), 132 | Range.rangeStartup 133 | ) 134 | ]), 135 | None, Range.rangeStartup 136 | ), 137 | None, 138 | expr, 139 | Range.rangeStartup, 140 | NoSequencePointAtInvisibleBinding 141 | ) 142 | let mkEncodeMemberBinding paramName typ expr = 143 | SynBinding.Binding( 144 | None, 145 | SynBindingKind.NormalBinding, 146 | yes, 147 | no, 148 | [], 149 | PreXmlDoc.Empty, 150 | SynValData(Some { 151 | IsInstance = false 152 | IsDispatchSlot = false 153 | IsOverrideOrExplicitImpl = false 154 | IsFinal = false 155 | MemberKind = MemberKind.Member }, 156 | SynValInfo( 157 | [[SynArgInfo ([],false, Ident.Create paramName |> Some)]], 158 | SynArgInfo ([],false,None)), 159 | None), 160 | SynPat.LongIdent( 161 | LongIdentWithDots.CreateString "Encode", 162 | None, None, 163 | SynConstructorArgs.Pats([ 164 | SynPat.Paren( 165 | SynPat.Typed( 166 | SynPat.Named( 167 | SynPat.Wild(Range.rangeStartup), 168 | Ident.Create paramName, false, None, Range.rangeStartup 169 | ), 170 | SynType.LongIdent(LongIdentWithDots.CreateString typ), 171 | Range.rangeStartup 172 | ), 173 | Range.rangeStartup 174 | ) 175 | ]), 176 | None, Range.rangeStartup 177 | ), 178 | None, 179 | expr, 180 | Range.rangeStartup, 181 | NoSequencePointAtInvisibleBinding 182 | ) 183 | 184 | let mkFullMemberFromBinding binding = SynMemberDefn.Member(binding, Range.rangeStartup) 185 | 186 | let primitiveTypesDeserialization = 187 | let numberIdent = LongIdentWithDots.CreateString "number" |> List.singleton 188 | seq { 189 | "int16", mkUncurriedSimpleCall (LongIdentWithDots.CreateString "System.Int16.Parse") numberIdent 190 | "int32", mkUncurriedSimpleCall (LongIdentWithDots.CreateString "System.Int32.Parse") numberIdent 191 | "int64", mkUncurriedSimpleCall (LongIdentWithDots.CreateString "System.Int64.Parse") numberIdent 192 | "uint16", mkUncurriedSimpleCall (LongIdentWithDots.CreateString "System.Uint16.Parse") numberIdent 193 | "uint32", mkUncurriedSimpleCall (LongIdentWithDots.CreateString "System.Uint32.Parse") numberIdent 194 | "uint64", mkUncurriedSimpleCall (LongIdentWithDots.CreateString "System.Uint64.Parse") numberIdent 195 | "byte", mkUncurriedSimpleCall (LongIdentWithDots.CreateString "System.Byte.Parse") numberIdent 196 | "sbyte", mkUncurriedSimpleCall (LongIdentWithDots.CreateString "System.Sbyte.Parse") numberIdent 197 | "float", mkUncurriedSimpleCall (LongIdentWithDots.CreateString "System.Float.Parse") numberIdent 198 | "float32", mkUncurriedSimpleCall (LongIdentWithDots.CreateString "System.Single.Parse") numberIdent 199 | } 200 | |> Seq.map(fun (typeName, expr) -> 201 | expr 202 | |> mkEncodeMemberBinding "number" typeName 203 | |> mkFullMemberFromBinding) 204 | 205 | let primitiveTypesEncoding = 206 | let callToString = mkUncurriedSimpleCall (LongIdentWithDots.CreateString "number.ToString") [] 207 | seq { 208 | "int16" 209 | "int32" 210 | "int64" 211 | "uint16" 212 | "uint32" 213 | "uint64" 214 | "float" 215 | "float32" 216 | "byte" 217 | "sbyte" 218 | } 219 | |> Seq.map(fun typeName -> 220 | Ident.Create "number" 221 | |> SynExpr.CreateIdent 222 | |> mkUncurriedSimpleExprCall (LongIdentWithDots.CreateString "decimal") 223 | |> mkUncurriedSimpleExprCall (LongIdentWithDots.CreateString "JsonValue.Number") 224 | |> mkEncodeMemberBinding "number" typeName 225 | |> mkFullMemberFromBinding) 226 | 227 | let stringEncoder = 228 | let name = "str" 229 | let typ = "string" 230 | Ident.Create name 231 | |> SynExpr.CreateIdent 232 | |> mkUncurriedSimpleExprCall (LongIdentWithDots.CreateString "JsonValue.String") 233 | |> mkEncodeMemberBinding name typ 234 | |> mkFullMemberFromBinding 235 | 236 | let arrayEncoder = 237 | let name = "list" 238 | let typ = 239 | SynType.HashConstraint( 240 | SynType.App( 241 | SynType.CreateLongIdent "array", 242 | None, 243 | [SynType.Var( 244 | SynTypar.Typar(Ident.Create "a", TyparStaticReq.NoStaticReq, false), 245 | Range.rangeStartup 246 | )], 247 | [], 248 | None, 249 | false, 250 | Range.rangeStartup 251 | ), 252 | Range.rangeStartup 253 | ) 254 | // "#seq<'a>" 255 | let expr = 256 | SynExpr.App 257 | (ExprAtomicFlag.NonAtomic,false, 258 | SynExpr.App 259 | (ExprAtomicFlag.NonAtomic,true, SynExpr.CreateIdentString "op_PipeRight", SynExpr.CreateIdentString "list", 260 | Range.rangeStartup), 261 | SynExpr.App 262 | (ExprAtomicFlag.Atomic,false, 263 | SynExpr.LongIdent 264 | (false, 265 | LongIdentWithDots 266 | ([Ident.Create "Seq"; Ident.Create "map" ],[Range.rangeStartup]), 267 | None,Range.rangeStartup), 268 | SynExpr.Paren 269 | (SynExpr.Lambda 270 | (false,false, 271 | SynSimplePats.SimplePats 272 | ([SynSimplePat.Id 273 | (Ident.Create "element",None,false,false,false, 274 | Range.rangeStartup)], 275 | Range.rangeStartup), 276 | SynExpr.App 277 | (ExprAtomicFlag.NonAtomic,false, 278 | SynExpr.LongIdent 279 | (false, 280 | LongIdentWithDots 281 | ([Ident.Create "Encoder"; Ident.Create "Encode" ], 282 | [Range.rangeStartup]), 283 | None,Range.rangeStartup), 284 | SynExpr.CreateIdentString "element", 285 | Range.rangeStartup), 286 | Range.rangeStartup), 287 | Range.rangeStartup, 288 | Some Range.rangeStartup, 289 | Range.rangeStartup), 290 | Range.rangeStartup), 291 | Range.rangeStartup) 292 | 293 | expr 294 | |> mkUncurriedSimpleExprCall (LongIdentWithDots.CreateString "Seq.toArray") 295 | |> mkUncurriedSimpleExprCall (LongIdentWithDots.CreateString "JsonValue.Array") 296 | |> mkEncodeMemberBindingSpecialType name typ 297 | |> mkFullMemberFromBinding 298 | 299 | 300 | let boolEncoder = 301 | let name = "value" 302 | let typ = "bool" 303 | Ident.Create name 304 | |> SynExpr.CreateIdent 305 | |> mkUncurriedSimpleExprCall (LongIdentWithDots.CreateString "JsonValue.Boolean") 306 | |> mkEncodeMemberBinding name typ 307 | |> mkFullMemberFromBinding 308 | 309 | let defaultEncoders = 310 | primitiveTypesEncoding 311 | |> Seq.append [ 312 | stringEncoder 313 | boolEncoder 314 | arrayEncoder 315 | ] 316 | 317 | let mkEncodeMemberBindingFromRecordField (moduleIdent: LongIdent) typeIdent recordFields = 318 | let currObjectTypeName = typeIdent |> List.append moduleIdent |> List.map(fun ident -> ident.idText) |> String.concat "." 319 | let currObjectName = typeIdent |> List.last |> (fun last -> last.idText.ToLower()) 320 | let fields = 321 | seq { 322 | for Field(_, _, fieldIdentOption, synType, _, _, _, _fieldRange) in recordFields do 323 | match fieldIdentOption with 324 | | None -> () 325 | | Some fieldIdent -> 326 | match synType with 327 | | SynType.LongIdent typeIdent -> yield (fieldIdent.idText, typeIdent.AsString) 328 | | _ -> () 329 | } 330 | let expr = 331 | let fieldEncoders = 332 | [| for (fieldName, _) in fields -> 333 | SynExpr.Tuple([ 334 | SynConst.CreateString fieldName 335 | |> SynExpr.CreateConst 336 | SynExpr.CreateApp( 337 | SynExpr.CreateLongIdent( 338 | false, 339 | LongIdentWithDots.CreateString "Encoder.Encode", 340 | None 341 | ), 342 | SynExpr.CreateParen( 343 | SynExpr.CreateLongIdent( 344 | false, 345 | LongIdentWithDots.Create [ currObjectName; fieldName ], 346 | None 347 | ) 348 | ) 349 | ) 350 | ], [], Range.rangeStartup) |] 351 | |> Array.reduceBack(fun expr1 expr2 -> 352 | SynExpr.Sequential( 353 | SequencePointsAtSeq, true, 354 | expr1, 355 | expr2, 356 | Range.rangeStartup 357 | ) 358 | ) 359 | SynExpr.ArrayOrListOfSeqExpr( 360 | true, 361 | SynExpr.CompExpr( 362 | true, 363 | ref true, 364 | fieldEncoders, 365 | Range.rangeStartup 366 | ), 367 | Range.rangeStartup 368 | ) 369 | expr 370 | |> mkUncurriedSimpleExprCall (LongIdentWithDots.CreateString "JsonValue.Record") 371 | |> mkEncodeMemberBinding currObjectName currObjectTypeName 372 | |> mkFullMemberFromBinding 373 | 374 | let mkEncodeMemberBindingFromUnionDecl (moduleIdent: LongIdent) typeIdent (cases: SynUnionCases) = 375 | let currObjectTypeName = typeIdent |> List.append moduleIdent |> List.map(fun ident -> ident.idText) |> String.concat "." 376 | let currObjectName = typeIdent |> List.last |> (fun last -> last.idText.ToLower()) 377 | let caseEncoders = 378 | let synPatUnionCaseFields (fields: SynFields) = 379 | match fields with 380 | | [] -> SynPat.Wild(Range.rangeStartup) 381 | | _ -> 382 | SynPat.Tuple( 383 | [ 384 | for field in fields -> 385 | SynPat.Named( 386 | SynPat.Wild(Range.rangeStartup), 387 | field.ToRcd.Id |> Option.get, // Save to call because it's checked before call 388 | false, 389 | None, 390 | Range.rangeStartup 391 | ) 392 | ], 393 | Range.rangeStartup 394 | ) 395 | let encodeUnionCase (caseIdent: Ident) (fields: SynFields) = 396 | let expr = 397 | match fields with 398 | | [] -> SynExpr.ArrayOrList(true, [], Range.rangeStartup) 399 | | _ -> 400 | let fieldEncoders = 401 | [| for field in fields -> 402 | let fieldName = field.ToRcd.Id |> Option.get in 403 | SynExpr.Tuple([ 404 | SynConst.CreateString fieldName.idText |> SynExpr.CreateConst 405 | SynExpr.CreateApp( 406 | SynExpr.CreateLongIdent( 407 | false, 408 | LongIdentWithDots.CreateString "Encoder.Encode", 409 | None 410 | ), 411 | SynExpr.CreateParen( 412 | SynExpr.CreateLongIdent( 413 | false, 414 | LongIdentWithDots([fieldName], []), // Save to call because it's checked before call 415 | None 416 | ) 417 | ) 418 | ) 419 | ], [], Range.rangeStartup) |] 420 | |> Array.reduceBack(fun expr1 expr2 -> 421 | SynExpr.Sequential( 422 | SequencePointsAtSeq, true, 423 | expr1, 424 | expr2, 425 | Range.rangeStartup 426 | ) 427 | ) 428 | SynExpr.ArrayOrListOfSeqExpr( 429 | true, 430 | SynExpr.CompExpr( 431 | true, 432 | ref true, 433 | fieldEncoders, 434 | Range.rangeStartup 435 | ), 436 | Range.rangeStartup 437 | ) 438 | |> mkUncurriedSimpleExprCall (LongIdentWithDots.CreateString "JsonValue.Record") 439 | SynExpr.Tuple([ 440 | SynExpr.CreateConstString (caseIdent.idText) 441 | expr 442 | ], [], Range.rangeStartup) 443 | seq { 444 | for UnionCase(_attrs, ident, caseType, _, _, range) in cases do 445 | let caseName = ident 446 | match caseType with 447 | | SynUnionCaseType.UnionCaseFullType _ -> failwithf "Unsupported union case %A of union %A" ident currObjectTypeName 448 | | SynUnionCaseType.UnionCaseFields fields -> 449 | if fields |> List.exists(fun field -> field.ToRcd.Id |> Option.isNone) then 450 | failwithf "All fields of case %A from union %A need to have a identifier!" caseName currObjectTypeName 451 | else 452 | SynMatchClause.Clause(SynPat.LongIdent 453 | (LongIdentWithDots ([caseName] |> List.append typeIdent |> List.append moduleIdent,[]), 454 | None,None, 455 | Pats 456 | [ synPatUnionCaseFields fields ], 457 | None, 458 | Range.rangeStartup), 459 | None, 460 | encodeUnionCase ident fields, 461 | Range.rangeStartup, 462 | SequencePointAtTarget) 463 | } 464 | 465 | 466 | SynExpr.App 467 | (ExprAtomicFlag.NonAtomic, 468 | false, 469 | SynExpr.CreateLongIdent(false, 470 | LongIdentWithDots.CreateString "JsonValue.Record", 471 | None), 472 | SynExpr.ArrayOrListOfSeqExpr 473 | (true, 474 | SynExpr.CompExpr 475 | (true, 476 | ref true, 477 | SynExpr.Match 478 | (Range.rangeStartup |> SequencePointAtBinding, 479 | Ident.Create currObjectName |> SynExpr.Ident, 480 | caseEncoders |> Seq.toList, 481 | false, 482 | Range.rangeStartup), 483 | Range.rangeStartup 484 | ), 485 | Range.rangeStartup 486 | ), 487 | Range.rangeStartup 488 | ) 489 | |> mkEncodeMemberBinding currObjectName currObjectTypeName 490 | |> mkFullMemberFromBinding 491 | 492 | let openJsonPluginNamespace = 493 | LongIdentWithDots.CreateString "JsonPlugin.Types" 494 | |> SynModuleDecl.CreateOpen 495 | 496 | interface IMyriadGenerator with 497 | member __.Generate(namespace', _ast) = 498 | printfn "Hi" 499 | let relevantDecls = 500 | seq { 501 | match _ast with 502 | | ParsedInput.ImplFile(ParsedImplFileInput(fileName, isScript, _, _, _, modules, _)) -> 503 | for SynModuleOrNamespace(moduleIdent, _, _, decls, _, _, _, range) in modules do 504 | for decl in decls do 505 | match decl with 506 | | SynModuleDecl.Types(types, _) -> 507 | for SynTypeDefn.TypeDefn(componentInfo, typeDefnRepr, _members, _) in types do 508 | let (ComponentInfo(typeAttributes, _typeParams, _constraints, typeIdent, _, _, _, _)) = componentInfo 509 | printfn "%A" typeAttributes 510 | if typeAttributes |> List.exists(fun attr -> (Util.getAttributeName attr) = (typeof.FullName.Replace("Attribute", ""))) then 511 | match typeDefnRepr with 512 | | SynTypeDefnRepr.Simple(repr, _) -> 513 | match repr with 514 | | SynTypeDefnSimpleRepr.Union(_, cases, _) -> 515 | yield WhatIsThat.ItsAnUnion(moduleIdent, typeIdent, cases) 516 | | SynTypeDefnSimpleRepr.Record(_, recordFields, recordDefinitionRange) -> 517 | yield WhatIsThat.ItsAnRecord(moduleIdent, typeIdent, recordFields) 518 | | _ -> () 519 | | _ -> () 520 | | _ -> () 521 | | _ -> () 522 | } 523 | let serializer = 524 | relevantDecls 525 | |> Seq.map(function 526 | | WhatIsThat.ItsAnRecord(moduleIdent, typeIdent, recordFields) -> 527 | mkEncodeMemberBindingFromRecordField moduleIdent typeIdent recordFields 528 | | WhatIsThat.ItsAnUnion(moduleIdent, typeIdent, cases) -> 529 | mkEncodeMemberBindingFromUnionDecl moduleIdent typeIdent cases 530 | ) 531 | |> Seq.append defaultEncoders 532 | |> Seq.toList |> mkEncoder 533 | 534 | let namespaceOrModule = 535 | { SynModuleOrNamespaceRcd.CreateNamespace(Ident.CreateLong namespace') 536 | with Declarations = [ 537 | openJsonPluginNamespace 538 | serializer ] 539 | } 540 | 541 | namespaceOrModule -------------------------------------------------------------------------------- /MyriadTesting/JsonPlugin/Types.fs: -------------------------------------------------------------------------------- 1 | module JsonPlugin.Types 2 | 3 | type JsonValue = 4 | | String of string 5 | | Number of decimal 6 | | Record of properties:(string * JsonValue)[] 7 | | Array of elements:JsonValue[] 8 | | Boolean of bool 9 | | Null -------------------------------------------------------------------------------- /MyriadTesting/JsonPlugin/Util.fs: -------------------------------------------------------------------------------- 1 | module Util 2 | 3 | open Quotations.Patterns 4 | 5 | //let quotationToFSharpAST (quotation: Quotations.Expr) = 6 | // let a = <@ let a = "" in a @> 7 | // match a with 8 | // | Let(var, left, right) -> 9 | -------------------------------------------------------------------------------- /MyriadTesting/JsonPlugin/build.props: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | -------------------------------------------------------------------------------- /MyriadTesting/MyriadTesting.sln: -------------------------------------------------------------------------------- 1 |  2 | Microsoft Visual Studio Solution File, Format Version 12.00 3 | # Visual Studio Version 16 4 | VisualStudioVersion = 16.0.29709.97 5 | MinimumVisualStudioVersion = 10.0.40219.1 6 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Example", "Example\Example.fsproj", "{29C06810-3069-4223-B08A-E39AFA6A6DFE}" 7 | EndProject 8 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "JsonPlugin", "JsonPlugin\JsonPlugin.fsproj", "{108C26EE-C38D-4AD4-8BB4-EBBB68F319EF}" 9 | EndProject 10 | Global 11 | GlobalSection(SolutionConfigurationPlatforms) = preSolution 12 | Debug|Any CPU = Debug|Any CPU 13 | Release|Any CPU = Release|Any CPU 14 | EndGlobalSection 15 | GlobalSection(ProjectConfigurationPlatforms) = postSolution 16 | {29C06810-3069-4223-B08A-E39AFA6A6DFE}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 17 | {29C06810-3069-4223-B08A-E39AFA6A6DFE}.Debug|Any CPU.Build.0 = Debug|Any CPU 18 | {29C06810-3069-4223-B08A-E39AFA6A6DFE}.Release|Any CPU.ActiveCfg = Release|Any CPU 19 | {29C06810-3069-4223-B08A-E39AFA6A6DFE}.Release|Any CPU.Build.0 = Release|Any CPU 20 | {108C26EE-C38D-4AD4-8BB4-EBBB68F319EF}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 21 | {108C26EE-C38D-4AD4-8BB4-EBBB68F319EF}.Debug|Any CPU.Build.0 = Debug|Any CPU 22 | {108C26EE-C38D-4AD4-8BB4-EBBB68F319EF}.Release|Any CPU.ActiveCfg = Release|Any CPU 23 | {108C26EE-C38D-4AD4-8BB4-EBBB68F319EF}.Release|Any CPU.Build.0 = Release|Any CPU 24 | EndGlobalSection 25 | GlobalSection(SolutionProperties) = preSolution 26 | HideSolutionNode = FALSE 27 | EndGlobalSection 28 | GlobalSection(ExtensibilityGlobals) = postSolution 29 | SolutionGuid = {7A680F3A-1F96-4F00-92D8-71D8E0FDF039} 30 | EndGlobalSection 31 | EndGlobal 32 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Compile time json serializers/deserializers for F# 2 | This library is under construction, however below you can see how things already look like. 3 | 4 | ![showcase](MyriadTesting/JsonPlugin.gif) --------------------------------------------------------------------------------