├── .github └── workflows │ └── ci.yml ├── .gitignore ├── LICENSE ├── README.md ├── package.json ├── packages.dhall ├── spago.dhall ├── src └── Data │ └── Argonaut │ └── Aeson │ ├── Decode │ └── Generic.purs │ ├── Encode │ └── Generic.purs │ ├── Helpers.purs │ └── Options.purs └── test └── Main.purs /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | # source: https://github.com/purescript-contrib/purescript-argonaut-generic/blob/main/.github/workflows/ci.yml 2 | name: CI 3 | 4 | on: 5 | push: 6 | branches: '*' 7 | pull_request: 8 | branches: '*' 9 | 10 | jobs: 11 | build: 12 | runs-on: ubuntu-latest 13 | 14 | steps: 15 | - uses: actions/checkout@v2 16 | 17 | - name: Set up a PureScript toolchain 18 | uses: purescript-contrib/setup-purescript@main 19 | with: 20 | purescript: "0.15.4" 21 | 22 | - name: Cache PureScript dependencies 23 | uses: actions/cache@v2 24 | with: 25 | key: ${{ runner.os }}-spago-${{ hashFiles('**/*.dhall') }} 26 | path: | 27 | .spago 28 | output 29 | - name: Install dependencies 30 | run: spago install 31 | 32 | - name: Build source 33 | run: spago build --no-install 34 | 35 | - name: Run tests 36 | run: spago test --no-install 37 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /bower_components/ 2 | /node_modules/ 3 | /.pulp-cache/ 4 | /output/ 5 | /generated-docs/ 6 | /.psc-package/ 7 | /.psc* 8 | /.purs* 9 | /.psa* 10 | /.spago 11 | yarn.lock -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Mozilla Public License Version 2.0 2 | ================================== 3 | 4 | 1. Definitions 5 | -------------- 6 | 7 | 1.1. "Contributor" 8 | means each individual or legal entity that creates, contributes to 9 | the creation of, or owns Covered Software. 10 | 11 | 1.2. "Contributor Version" 12 | means the combination of the Contributions of others (if any) used 13 | by a Contributor and that particular Contributor's Contribution. 14 | 15 | 1.3. "Contribution" 16 | means Covered Software of a particular Contributor. 17 | 18 | 1.4. "Covered Software" 19 | means Source Code Form to which the initial Contributor has attached 20 | the notice in Exhibit A, the Executable Form of such Source Code 21 | Form, and Modifications of such Source Code Form, in each case 22 | including portions thereof. 23 | 24 | 1.5. "Incompatible With Secondary Licenses" 25 | means 26 | 27 | (a) that the initial Contributor has attached the notice described 28 | in Exhibit B to the Covered Software; or 29 | 30 | (b) that the Covered Software was made available under the terms of 31 | version 1.1 or earlier of the License, but not also under the 32 | terms of a Secondary License. 33 | 34 | 1.6. "Executable Form" 35 | means any form of the work other than Source Code Form. 36 | 37 | 1.7. "Larger Work" 38 | means a work that combines Covered Software with other material, in 39 | a separate file or files, that is not Covered Software. 40 | 41 | 1.8. "License" 42 | means this document. 43 | 44 | 1.9. "Licensable" 45 | means having the right to grant, to the maximum extent possible, 46 | whether at the time of the initial grant or subsequently, any and 47 | all of the rights conveyed by this License. 48 | 49 | 1.10. "Modifications" 50 | means any of the following: 51 | 52 | (a) any file in Source Code Form that results from an addition to, 53 | deletion from, or modification of the contents of Covered 54 | Software; or 55 | 56 | (b) any new file in Source Code Form that contains any Covered 57 | Software. 58 | 59 | 1.11. "Patent Claims" of a Contributor 60 | means any patent claim(s), including without limitation, method, 61 | process, and apparatus claims, in any patent Licensable by such 62 | Contributor that would be infringed, but for the grant of the 63 | License, by the making, using, selling, offering for sale, having 64 | made, import, or transfer of either its Contributions or its 65 | Contributor Version. 66 | 67 | 1.12. "Secondary License" 68 | means either the GNU General Public License, Version 2.0, the GNU 69 | Lesser General Public License, Version 2.1, the GNU Affero General 70 | Public License, Version 3.0, or any later versions of those 71 | licenses. 72 | 73 | 1.13. "Source Code Form" 74 | means the form of the work preferred for making modifications. 75 | 76 | 1.14. "You" (or "Your") 77 | means an individual or a legal entity exercising rights under this 78 | License. For legal entities, "You" includes any entity that 79 | controls, is controlled by, or is under common control with You. For 80 | purposes of this definition, "control" means (a) the power, direct 81 | or indirect, to cause the direction or management of such entity, 82 | whether by contract or otherwise, or (b) ownership of more than 83 | fifty percent (50%) of the outstanding shares or beneficial 84 | ownership of such entity. 85 | 86 | 2. License Grants and Conditions 87 | -------------------------------- 88 | 89 | 2.1. Grants 90 | 91 | Each Contributor hereby grants You a world-wide, royalty-free, 92 | non-exclusive license: 93 | 94 | (a) under intellectual property rights (other than patent or trademark) 95 | Licensable by such Contributor to use, reproduce, make available, 96 | modify, display, perform, distribute, and otherwise exploit its 97 | Contributions, either on an unmodified basis, with Modifications, or 98 | as part of a Larger Work; and 99 | 100 | (b) under Patent Claims of such Contributor to make, use, sell, offer 101 | for sale, have made, import, and otherwise transfer either its 102 | Contributions or its Contributor Version. 103 | 104 | 2.2. Effective Date 105 | 106 | The licenses granted in Section 2.1 with respect to any Contribution 107 | become effective for each Contribution on the date the Contributor first 108 | distributes such Contribution. 109 | 110 | 2.3. Limitations on Grant Scope 111 | 112 | The licenses granted in this Section 2 are the only rights granted under 113 | this License. No additional rights or licenses will be implied from the 114 | distribution or licensing of Covered Software under this License. 115 | Notwithstanding Section 2.1(b) above, no patent license is granted by a 116 | Contributor: 117 | 118 | (a) for any code that a Contributor has removed from Covered Software; 119 | or 120 | 121 | (b) for infringements caused by: (i) Your and any other third party's 122 | modifications of Covered Software, or (ii) the combination of its 123 | Contributions with other software (except as part of its Contributor 124 | Version); or 125 | 126 | (c) under Patent Claims infringed by Covered Software in the absence of 127 | its Contributions. 128 | 129 | This License does not grant any rights in the trademarks, service marks, 130 | or logos of any Contributor (except as may be necessary to comply with 131 | the notice requirements in Section 3.4). 132 | 133 | 2.4. Subsequent Licenses 134 | 135 | No Contributor makes additional grants as a result of Your choice to 136 | distribute the Covered Software under a subsequent version of this 137 | License (see Section 10.2) or under the terms of a Secondary License (if 138 | permitted under the terms of Section 3.3). 139 | 140 | 2.5. Representation 141 | 142 | Each Contributor represents that the Contributor believes its 143 | Contributions are its original creation(s) or it has sufficient rights 144 | to grant the rights to its Contributions conveyed by this License. 145 | 146 | 2.6. Fair Use 147 | 148 | This License is not intended to limit any rights You have under 149 | applicable copyright doctrines of fair use, fair dealing, or other 150 | equivalents. 151 | 152 | 2.7. Conditions 153 | 154 | Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted 155 | in Section 2.1. 156 | 157 | 3. Responsibilities 158 | ------------------- 159 | 160 | 3.1. Distribution of Source Form 161 | 162 | All distribution of Covered Software in Source Code Form, including any 163 | Modifications that You create or to which You contribute, must be under 164 | the terms of this License. You must inform recipients that the Source 165 | Code Form of the Covered Software is governed by the terms of this 166 | License, and how they can obtain a copy of this License. You may not 167 | attempt to alter or restrict the recipients' rights in the Source Code 168 | Form. 169 | 170 | 3.2. Distribution of Executable Form 171 | 172 | If You distribute Covered Software in Executable Form then: 173 | 174 | (a) such Covered Software must also be made available in Source Code 175 | Form, as described in Section 3.1, and You must inform recipients of 176 | the Executable Form how they can obtain a copy of such Source Code 177 | Form by reasonable means in a timely manner, at a charge no more 178 | than the cost of distribution to the recipient; and 179 | 180 | (b) You may distribute such Executable Form under the terms of this 181 | License, or sublicense it under different terms, provided that the 182 | license for the Executable Form does not attempt to limit or alter 183 | the recipients' rights in the Source Code Form under this License. 184 | 185 | 3.3. Distribution of a Larger Work 186 | 187 | You may create and distribute a Larger Work under terms of Your choice, 188 | provided that You also comply with the requirements of this License for 189 | the Covered Software. If the Larger Work is a combination of Covered 190 | Software with a work governed by one or more Secondary Licenses, and the 191 | Covered Software is not Incompatible With Secondary Licenses, this 192 | License permits You to additionally distribute such Covered Software 193 | under the terms of such Secondary License(s), so that the recipient of 194 | the Larger Work may, at their option, further distribute the Covered 195 | Software under the terms of either this License or such Secondary 196 | License(s). 197 | 198 | 3.4. Notices 199 | 200 | You may not remove or alter the substance of any license notices 201 | (including copyright notices, patent notices, disclaimers of warranty, 202 | or limitations of liability) contained within the Source Code Form of 203 | the Covered Software, except that You may alter any license notices to 204 | the extent required to remedy known factual inaccuracies. 205 | 206 | 3.5. Application of Additional Terms 207 | 208 | You may choose to offer, and to charge a fee for, warranty, support, 209 | indemnity or liability obligations to one or more recipients of Covered 210 | Software. However, You may do so only on Your own behalf, and not on 211 | behalf of any Contributor. You must make it absolutely clear that any 212 | such warranty, support, indemnity, or liability obligation is offered by 213 | You alone, and You hereby agree to indemnify every Contributor for any 214 | liability incurred by such Contributor as a result of warranty, support, 215 | indemnity or liability terms You offer. You may include additional 216 | disclaimers of warranty and limitations of liability specific to any 217 | jurisdiction. 218 | 219 | 4. Inability to Comply Due to Statute or Regulation 220 | --------------------------------------------------- 221 | 222 | If it is impossible for You to comply with any of the terms of this 223 | License with respect to some or all of the Covered Software due to 224 | statute, judicial order, or regulation then You must: (a) comply with 225 | the terms of this License to the maximum extent possible; and (b) 226 | describe the limitations and the code they affect. Such description must 227 | be placed in a text file included with all distributions of the Covered 228 | Software under this License. Except to the extent prohibited by statute 229 | or regulation, such description must be sufficiently detailed for a 230 | recipient of ordinary skill to be able to understand it. 231 | 232 | 5. Termination 233 | -------------- 234 | 235 | 5.1. The rights granted under this License will terminate automatically 236 | if You fail to comply with any of its terms. However, if You become 237 | compliant, then the rights granted under this License from a particular 238 | Contributor are reinstated (a) provisionally, unless and until such 239 | Contributor explicitly and finally terminates Your grants, and (b) on an 240 | ongoing basis, if such Contributor fails to notify You of the 241 | non-compliance by some reasonable means prior to 60 days after You have 242 | come back into compliance. Moreover, Your grants from a particular 243 | Contributor are reinstated on an ongoing basis if such Contributor 244 | notifies You of the non-compliance by some reasonable means, this is the 245 | first time You have received notice of non-compliance with this License 246 | from such Contributor, and You become compliant prior to 30 days after 247 | Your receipt of the notice. 248 | 249 | 5.2. If You initiate litigation against any entity by asserting a patent 250 | infringement claim (excluding declaratory judgment actions, 251 | counter-claims, and cross-claims) alleging that a Contributor Version 252 | directly or indirectly infringes any patent, then the rights granted to 253 | You by any and all Contributors for the Covered Software under Section 254 | 2.1 of this License shall terminate. 255 | 256 | 5.3. In the event of termination under Sections 5.1 or 5.2 above, all 257 | end user license agreements (excluding distributors and resellers) which 258 | have been validly granted by You or Your distributors under this License 259 | prior to termination shall survive termination. 260 | 261 | ************************************************************************ 262 | * * 263 | * 6. Disclaimer of Warranty * 264 | * ------------------------- * 265 | * * 266 | * Covered Software is provided under this License on an "as is" * 267 | * basis, without warranty of any kind, either expressed, implied, or * 268 | * statutory, including, without limitation, warranties that the * 269 | * Covered Software is free of defects, merchantable, fit for a * 270 | * particular purpose or non-infringing. The entire risk as to the * 271 | * quality and performance of the Covered Software is with You. * 272 | * Should any Covered Software prove defective in any respect, You * 273 | * (not any Contributor) assume the cost of any necessary servicing, * 274 | * repair, or correction. This disclaimer of warranty constitutes an * 275 | * essential part of this License. No use of any Covered Software is * 276 | * authorized under this License except under this disclaimer. * 277 | * * 278 | ************************************************************************ 279 | 280 | ************************************************************************ 281 | * * 282 | * 7. Limitation of Liability * 283 | * -------------------------- * 284 | * * 285 | * Under no circumstances and under no legal theory, whether tort * 286 | * (including negligence), contract, or otherwise, shall any * 287 | * Contributor, or anyone who distributes Covered Software as * 288 | * permitted above, be liable to You for any direct, indirect, * 289 | * special, incidental, or consequential damages of any character * 290 | * including, without limitation, damages for lost profits, loss of * 291 | * goodwill, work stoppage, computer failure or malfunction, or any * 292 | * and all other commercial damages or losses, even if such party * 293 | * shall have been informed of the possibility of such damages. This * 294 | * limitation of liability shall not apply to liability for death or * 295 | * personal injury resulting from such party's negligence to the * 296 | * extent applicable law prohibits such limitation. Some * 297 | * jurisdictions do not allow the exclusion or limitation of * 298 | * incidental or consequential damages, so this exclusion and * 299 | * limitation may not apply to You. * 300 | * * 301 | ************************************************************************ 302 | 303 | 8. Litigation 304 | ------------- 305 | 306 | Any litigation relating to this License may be brought only in the 307 | courts of a jurisdiction where the defendant maintains its principal 308 | place of business and such litigation shall be governed by laws of that 309 | jurisdiction, without reference to its conflict-of-law provisions. 310 | Nothing in this Section shall prevent a party's ability to bring 311 | cross-claims or counter-claims. 312 | 313 | 9. Miscellaneous 314 | ---------------- 315 | 316 | This License represents the complete agreement concerning the subject 317 | matter hereof. If any provision of this License is held to be 318 | unenforceable, such provision shall be reformed only to the extent 319 | necessary to make it enforceable. Any law or regulation which provides 320 | that the language of a contract shall be construed against the drafter 321 | shall not be used to construe this License against a Contributor. 322 | 323 | 10. Versions of the License 324 | --------------------------- 325 | 326 | 10.1. New Versions 327 | 328 | Mozilla Foundation is the license steward. Except as provided in Section 329 | 10.3, no one other than the license steward has the right to modify or 330 | publish new versions of this License. Each version will be given a 331 | distinguishing version number. 332 | 333 | 10.2. Effect of New Versions 334 | 335 | You may distribute the Covered Software under the terms of the version 336 | of the License under which You originally received the Covered Software, 337 | or under the terms of any subsequent version published by the license 338 | steward. 339 | 340 | 10.3. Modified Versions 341 | 342 | If you create software not governed by this License, and you want to 343 | create a new license for such software, you may create and use a 344 | modified version of this License if you rename the license and remove 345 | any references to the name of the license steward (except to note that 346 | such modified license differs from this License). 347 | 348 | 10.4. Distributing Source Code Form that is Incompatible With Secondary 349 | Licenses 350 | 351 | If You choose to distribute Source Code Form that is Incompatible With 352 | Secondary Licenses under the terms of this version of the License, the 353 | notice described in Exhibit B of this License must be attached. 354 | 355 | Exhibit A - Source Code Form License Notice 356 | ------------------------------------------- 357 | 358 | This Source Code Form is subject to the terms of the Mozilla Public 359 | License, v. 2.0. If a copy of the MPL was not distributed with this 360 | file, You can obtain one at http://mozilla.org/MPL/2.0/. 361 | 362 | If it is not possible or desirable to put the notice in a particular 363 | file, then You may include the notice in a location (such as a LICENSE 364 | file in a relevant directory) where a recipient would be likely to look 365 | for such a notice. 366 | 367 | You may add additional accurate notices of copyright ownership. 368 | 369 | Exhibit B - "Incompatible With Secondary Licenses" Notice 370 | --------------------------------------------------------- 371 | 372 | This Source Code Form is "Incompatible With Secondary Licenses", as 373 | defined by the Mozilla Public License, v. 2.0. 374 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Argonaut Aeson Generic Json Codecs 2 | 3 | [![Maintainer: coot](https://img.shields.io/badge/maintainer-coot-lightgrey.svg)](http://github.com/coot) 4 | [![Maintainer: peterbecich](https://img.shields.io/badge/maintainer-peterbecich-lightgrey.svg)](http://github.com/peterbecich) 5 | [![Documentation](https://pursuit.purescript.org/packages/purescript-argonaut-aeson-generic/badge)](https://pursuit.purescript.org/packages/purescript-argonaut-aeson-generic) 6 | [![CI](https://github.com/coot/purescript-argonaut-aeson-generic/actions/workflows/ci.yml/badge.svg)](https://github.com/coot/purescript-argonaut-aeson-generic/actions/workflows/ci.yml) 7 | 8 | Generic codec for aeson generic encoding. The promise is to support 9 | interoperation with [the generic encoding of Haskell's Aeson]. The default 10 | options mirror Aeson's _(so you can use `defaultOptions` on both sides)_, and 11 | additionally all combinations of flags `allNullaryToStringTag` and 12 | `tagSingleConstructors` are supported. 13 | 14 | The package provides `genericEncodeAeson` and `genericDecodeAeson` function for 15 | data types that have a `Generic.Rep` instance. 16 | 17 | It is updated to work with `purescript-0.15`. 18 | 19 | [the generic encoding of Haskell's Aeson]: https://hackage.haskell.org/package/aeson-1.5.4.1/docs/Data-Aeson.html#v:genericToJSON 20 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-argonaut-generic-aeson", 3 | "version": "0.3.0", 4 | "description": "argonaut aeson generic json codecs", 5 | "main": "index.js", 6 | "directories": { 7 | "test": "test" 8 | }, 9 | "scripts": { 10 | "test": "pulp test", 11 | "build": "pulp build" 12 | }, 13 | "repository": { 14 | "type": "git", 15 | "url": "git+ssh://git@github.com/coot/purescript-argonaut-aeson-generic.git" 16 | }, 17 | "keywords": [ 18 | "argonaut", 19 | "aeson", 20 | "generic", 21 | "purescript", 22 | "json" 23 | ], 24 | "author": "Marcin Szamotulski", 25 | "license": "MPL-2.0", 26 | "bugs": { 27 | "url": "https://github.com/coot/purescript-argonaut-aeson-generic/issues" 28 | }, 29 | "homepage": "https://github.com/coot/purescript-argonaut-aeson-generic#readme", 30 | "devDependencies": { 31 | "pulp": "^12.0.1" 32 | } 33 | } 34 | -------------------------------------------------------------------------------- /packages.dhall: -------------------------------------------------------------------------------- 1 | let upstream = 2 | https://github.com/purescript/package-sets/releases/download/psc-0.15.4-20220901/packages.dhall sha256:f1531b29c21ac437ffe5666c1b6cc76f0a9c29d3c9d107ff047aa2567744994f 3 | 4 | in upstream 5 | -------------------------------------------------------------------------------- /spago.dhall: -------------------------------------------------------------------------------- 1 | { name = "argonaut-aeson-generic" 2 | , dependencies = 3 | [ "argonaut-codecs" 4 | , "argonaut-core" 5 | , "argonaut-generic" 6 | , "arrays" 7 | , "bifunctors" 8 | , "control" 9 | , "effect" 10 | , "either" 11 | , "foldable-traversable" 12 | , "foreign-object" 13 | , "maybe" 14 | , "partial" 15 | , "prelude" 16 | , "psci-support" 17 | , "record" 18 | , "test-unit" 19 | , "typelevel-prelude" 20 | ] 21 | , packages = ./packages.dhall 22 | , sources = [ "src/**/*.purs", "test/**/*.purs" ] 23 | } 24 | -------------------------------------------------------------------------------- /src/Data/Argonaut/Aeson/Decode/Generic.purs: -------------------------------------------------------------------------------- 1 | module Data.Argonaut.Aeson.Decode.Generic 2 | ( class DecodeAeson 3 | , class DecodeAeson' 4 | , decodeAeson 5 | , decodeAeson' 6 | , genericDecodeAeson 7 | ) where 8 | 9 | import Prelude (Unit, bind, const, discard, identity, map, pure, show, unit, ($), (/=), (<$>), (<<<), (<>), (==), (>=>)) 10 | 11 | import Control.Alt ((<|>)) 12 | import Data.Argonaut.Aeson.Helpers (class AreAllConstructorsNullary, class IsSingleConstructor, Mode(..), areAllConstructorsNullary, isSingleConstructor) 13 | import Data.Argonaut.Aeson.Options (Options(Options), SumEncoding(..)) 14 | import Data.Argonaut.Core (Json, caseJson, caseJsonArray, caseJsonString, fromArray, fromBoolean, fromNumber, fromObject, fromString, jsonNull, toObject, toString) 15 | import Data.Argonaut.Decode.Generic (class DecodeRepArgs, decodeRepArgs) 16 | import Data.Array (singleton) 17 | import Data.Bifunctor (lmap) 18 | import Data.Argonaut.Decode.Error (JsonDecodeError(Named, MissingValue, TypeMismatch)) 19 | import Data.Either (Either(..), note) 20 | import Data.Generic.Rep as Rep 21 | import Data.Maybe (Maybe(..)) 22 | import Foreign.Object as Foreign 23 | import Data.Symbol (class IsSymbol, reflectSymbol) 24 | import Type.Proxy (Proxy(..)) 25 | import Partial.Unsafe 26 | 27 | class DecodeAeson r where 28 | decodeAeson :: Options -> Json -> Either JsonDecodeError r 29 | 30 | instance decodeAesonNoConstructors :: DecodeAeson Rep.NoConstructors where 31 | decodeAeson _ _ = Left $ Named "Cannot decode empty data type" MissingValue 32 | 33 | instance decodeAesonConstructor 34 | :: ( DecodeRepArgs a 35 | , IsSymbol name 36 | , AreAllConstructorsNullary (Rep.Constructor name a) 37 | , IsSingleConstructor (Rep.Constructor name a) 38 | , DecodeAeson' (Rep.Constructor name a) 39 | ) 40 | => DecodeAeson (Rep.Constructor name a) where 41 | decodeAeson o thing = decodeAeson' mode o thing 42 | where 43 | mode = Mode 44 | { _Mode_ConstructorIsSingle: isSingleConstructor (Proxy :: Proxy (Rep.Constructor name a)) 45 | , _Mode_ConstructorsAreAllNullary: areAllConstructorsNullary (Proxy :: Proxy (Rep.Constructor name a)) 46 | } 47 | 48 | instance decodeAesonSum 49 | :: ( DecodeAeson' (Rep.Sum a b) 50 | , AreAllConstructorsNullary (Rep.Sum a b) 51 | , IsSingleConstructor (Rep.Sum a b) 52 | ) 53 | => DecodeAeson (Rep.Sum a b) where 54 | decodeAeson o thing = decodeAeson' mode o thing 55 | where 56 | mode = Mode 57 | { _Mode_ConstructorIsSingle: isSingleConstructor (Proxy :: Proxy (Rep.Sum a b)) 58 | , _Mode_ConstructorsAreAllNullary: areAllConstructorsNullary (Proxy :: Proxy (Rep.Sum a b)) 59 | } 60 | 61 | class DecodeAeson' r where 62 | decodeAeson' :: Mode -> Options -> Json -> Either JsonDecodeError r 63 | 64 | instance decodeAesonNoConstructors' :: DecodeAeson' Rep.NoConstructors where 65 | decodeAeson' _ _ _ = Left $ Named "Cannot decode empty data type" MissingValue 66 | 67 | instance decodeAesonSum' :: (DecodeAeson' a, DecodeAeson' b) => DecodeAeson' (Rep.Sum a b) where 68 | decodeAeson' mode o j = Rep.Inl <$> decodeAeson' mode o j <|> Rep.Inr <$> decodeAeson' mode o j 69 | 70 | toJsonArray :: Json -> Array Json 71 | toJsonArray = caseJson 72 | (const $ singleton jsonNull) 73 | (singleton <<< fromBoolean) 74 | (singleton <<< fromNumber) 75 | (singleton <<< fromString) 76 | (singleton <<< fromArray) 77 | (singleton <<< fromObject) 78 | 79 | toJsonArrayProduct :: Json -> Array Json 80 | toJsonArrayProduct = caseJson 81 | (const $ singleton jsonNull) 82 | (singleton <<< fromBoolean) 83 | (singleton <<< fromNumber) 84 | (singleton <<< fromString) 85 | identity 86 | (singleton <<< fromObject) 87 | 88 | decodingErr :: String -> JsonDecodeError -> JsonDecodeError 89 | decodingErr name msg = Named ("When decoding a " <> name) msg 90 | 91 | checkTag :: String -> String -> Foreign.Object Json -> Either JsonDecodeError Unit 92 | checkTag tagFieldName expectedTag 93 | = note (Named (show tagFieldName <> " property is missing") MissingValue) <<< Foreign.lookup tagFieldName 94 | >=> note (TypeMismatch $ show tagFieldName <> " property is not a string") <<< toString 95 | >=> \ actualTag -> if actualTag /= expectedTag 96 | then Left (Named "'tag' property has an incorrect value" (TypeMismatch actualTag)) 97 | else Right unit 98 | 99 | instance decodeAesonConstructorNoArguments' :: IsSymbol name => DecodeAeson' (Rep.Constructor name (Rep.NoArguments)) where 100 | decodeAeson' mode options json = 101 | let name = reflectSymbol (Proxy :: Proxy name) 102 | in lmap (decodingErr name) case {mode: mode, options: options} of 103 | 104 | { mode: Mode {_Mode_ConstructorIsSingle: true} 105 | , options: Options {tagSingleConstructors: false} 106 | } -> case caseJsonArray Nothing Just json of 107 | Just [ ] -> Right (Rep.Constructor Rep.NoArguments) 108 | _ -> Left $ TypeMismatch "Expected an empty array!" 109 | 110 | { mode: Mode {_Mode_ConstructorsAreAllNullary: true} 111 | , options: Options {allNullaryToStringTag: true} 112 | } -> case caseJsonString Nothing Just json of 113 | Nothing -> Left $ TypeMismatch "Expected a string!" 114 | Just tag -> if tag == name 115 | then Right (Rep.Constructor Rep.NoArguments) 116 | else Left $ TypeMismatch "Mismatched constructor tag!" 117 | 118 | _ -> decodeGeneralCase mode options json 119 | 120 | instance decodeAesonConstructorProduct' :: (IsSymbol name, DecodeRepArgs a, DecodeRepArgs b) => DecodeAeson' (Rep.Constructor name (Rep.Product a b)) where 121 | decodeAeson' mode options json = 122 | let name = reflectSymbol (Proxy :: Proxy name) 123 | in lmap (decodingErr name) case {mode: mode, options: options} of 124 | 125 | { mode: Mode {_Mode_ConstructorIsSingle: true} 126 | , options: Options {tagSingleConstructors: false} 127 | } -> do 128 | {init, rest} <- (decodeRepArgs <<< caseJsonArray (singleton json) identity) json 129 | pure (Rep.Constructor init) 130 | 131 | { options: Options {sumEncoding: TaggedObject taggedObject} 132 | } -> do 133 | objectJson <- (note (TypeMismatch "expected an object") <<< toObject) json 134 | checkTag taggedObject.tagFieldName name objectJson 135 | {init, rest} <- case Foreign.lookup taggedObject.contentsFieldName objectJson of 136 | Just contents -> -- This must be an ordinary constructor. 137 | (decodeRepArgs <<< toJsonArrayProduct) contents 138 | Nothing -> -- This must be a record constructor. 139 | (decodeRepArgs <<< singleton <<< fromObject <<< Foreign.delete taggedObject.tagFieldName) objectJson 140 | pure (Rep.Constructor init) 141 | 142 | instance decodeAesonConstructor' :: (IsSymbol name, DecodeRepArgs (Rep.Argument a)) => DecodeAeson' (Rep.Constructor name (Rep.Argument a)) where 143 | decodeAeson' mode options json = 144 | let name = reflectSymbol (Proxy :: Proxy name) 145 | in lmap (decodingErr name) case {mode: mode, options: options} of 146 | 147 | { mode: Mode {_Mode_ConstructorsAreAllNullary: true} 148 | } -> unsafeCrashWith "Unreachable: cannot have all nullary constructors and an `Argument` constructor at once." 149 | 150 | { mode: Mode {_Mode_ConstructorIsSingle: true} 151 | , options: Options {tagSingleConstructors: false} 152 | } -> do 153 | {init, rest} <- (decodeRepArgs <<< caseJsonArray (singleton json) (singleton <<< fromArray)) json 154 | pure (Rep.Constructor init) 155 | 156 | _ -> decodeGeneralCase mode options json 157 | 158 | decodeGeneralCase :: forall name a. IsSymbol name => DecodeRepArgs a => Mode -> Options -> Json -> Either JsonDecodeError (Rep.Constructor name a) 159 | decodeGeneralCase mode options json = 160 | let name = reflectSymbol (Proxy :: Proxy name) 161 | in case {mode: mode, options: options} of 162 | { options: Options {sumEncoding: TaggedObject taggedObject} 163 | } -> do 164 | objectJson <- (note (TypeMismatch "expected an object") <<< toObject) json 165 | checkTag taggedObject.tagFieldName name objectJson 166 | {init, rest} <- case Foreign.lookup taggedObject.contentsFieldName objectJson of 167 | Just contents -> -- This must be an ordinary constructor. 168 | (decodeRepArgs <<< toJsonArray) contents 169 | Nothing -> -- This must be a record constructor. 170 | (decodeRepArgs <<< singleton <<< fromObject <<< Foreign.delete taggedObject.tagFieldName) objectJson 171 | pure (Rep.Constructor init) 172 | 173 | -- | Decode `Json` Aeson representation of a value which has a `Generic` type. 174 | genericDecodeAeson :: forall a r. Rep.Generic a r => DecodeAeson r => Options -> Json -> Either JsonDecodeError a 175 | genericDecodeAeson o = map Rep.to <<< decodeAeson o 176 | -------------------------------------------------------------------------------- /src/Data/Argonaut/Aeson/Encode/Generic.purs: -------------------------------------------------------------------------------- 1 | module Data.Argonaut.Aeson.Encode.Generic 2 | ( class EncodeAeson 3 | , class EncodeAeson' 4 | , class EncodeRepArgs 5 | , RepArgsEncoding(..) 6 | , class EncodeRepFields 7 | , encodeFields 8 | , encodeAeson 9 | , encodeAeson' 10 | , encodeRepArgs 11 | , genericEncodeAeson 12 | ) where 13 | 14 | import Prelude (class Semigroup, otherwise, ($), (<<<), (<>), (==)) 15 | 16 | import Record (get) 17 | import Data.Argonaut.Aeson.Options (Options(Options), SumEncoding(..)) 18 | import Data.Argonaut.Aeson.Helpers (class AreAllConstructorsNullary, class IsSingleConstructor, Mode(..), areAllConstructorsNullary, isSingleConstructor) 19 | import Data.Argonaut.Core (Json, fromArray, fromObject, fromString, jsonEmptyArray) 20 | import Data.Argonaut.Encode.Class (class EncodeJson, encodeJson) 21 | import Data.Array (cons, uncons, head, length, snoc) 22 | import Data.Generic.Rep as Rep 23 | import Data.Maybe (Maybe(..), fromJust) 24 | import Data.Symbol (class IsSymbol, reflectSymbol) 25 | import Foreign.Object as FO 26 | import Partial.Unsafe (unsafePartial) 27 | import Type.Proxy (Proxy(..)) 28 | import Type.Row (class Cons) 29 | import Type.RowList (Nil, Cons, RowList) 30 | 31 | class EncodeAeson r where 32 | encodeAeson :: Options -> r -> Json 33 | 34 | instance encodeAesonInt :: EncodeAeson' Int => EncodeAeson Int where 35 | encodeAeson = encodeAeson' mode 36 | where 37 | mode = Mode 38 | { _Mode_ConstructorIsSingle: false 39 | , _Mode_ConstructorsAreAllNullary: false 40 | } 41 | 42 | instance encodeAesonNoConstructors :: EncodeAeson' Rep.NoConstructors => EncodeAeson Rep.NoConstructors where 43 | encodeAeson = encodeAeson' mode 44 | where 45 | mode = Mode 46 | { _Mode_ConstructorIsSingle: false 47 | , _Mode_ConstructorsAreAllNullary: false 48 | } 49 | 50 | instance encodeAesonConstructor 51 | :: ( EncodeRepArgs a 52 | , IsSymbol name 53 | , AreAllConstructorsNullary (Rep.Constructor name a) 54 | , IsSingleConstructor (Rep.Constructor name a) 55 | ) 56 | => EncodeAeson (Rep.Constructor name a) where 57 | encodeAeson o thing = encodeAeson' mode o thing 58 | where 59 | mode = Mode 60 | { _Mode_ConstructorIsSingle: isSingleConstructor (Proxy :: Proxy (Rep.Constructor name a)) 61 | , _Mode_ConstructorsAreAllNullary: areAllConstructorsNullary (Proxy :: Proxy (Rep.Constructor name a)) 62 | } 63 | 64 | instance encodeAesonSum 65 | :: ( EncodeAeson' (Rep.Sum a b) 66 | , AreAllConstructorsNullary (Rep.Sum a b) 67 | , IsSingleConstructor (Rep.Sum a b) 68 | ) 69 | => EncodeAeson (Rep.Sum a b) where 70 | encodeAeson o thing = encodeAeson' mode o thing 71 | where 72 | mode = Mode 73 | { _Mode_ConstructorIsSingle: isSingleConstructor (Proxy :: Proxy (Rep.Sum a b)) 74 | , _Mode_ConstructorsAreAllNullary: areAllConstructorsNullary (Proxy :: Proxy (Rep.Sum a b)) 75 | } 76 | 77 | class EncodeAeson' r where 78 | encodeAeson' :: Mode -> Options -> r -> Json 79 | 80 | instance encodeAesonInt' :: EncodeAeson' Int where 81 | encodeAeson' _ _ = encodeJson 82 | 83 | instance encodeAesonNoConstructors' :: EncodeAeson' Rep.NoConstructors where 84 | encodeAeson' x = encodeAeson' x 85 | 86 | instance encodeAesonSum' :: (EncodeAeson' a, EncodeAeson' b) => EncodeAeson' (Rep.Sum a b) where 87 | encodeAeson' o mode (Rep.Inl a) = encodeAeson' o mode a 88 | encodeAeson' o mode (Rep.Inr b) = encodeAeson' o mode b 89 | 90 | data RepArgsEncoding 91 | = Arg (Array Json) 92 | | Rec (FO.Object Json) 93 | 94 | instance semigroupRepArgsEncoding :: Semigroup RepArgsEncoding where 95 | append (Arg a) (Arg b) = Arg (a <> b) 96 | append (Arg a) (Rec b) = Arg (snoc a $ fromObject b) 97 | append (Rec a) (Arg b) = Arg (cons (fromObject a) b) 98 | append (Rec a) (Rec b) = Arg [fromObject a, fromObject b] 99 | 100 | instance encodeAesonConstructor' :: (IsSymbol name, EncodeRepArgs a) => EncodeAeson' (Rep.Constructor name a) where 101 | encodeAeson' mode options (Rep.Constructor arguments) = 102 | let name = reflectSymbol (Proxy :: Proxy name) 103 | in case {mode: mode, options: options} of 104 | 105 | { mode: Mode {_Mode_ConstructorIsSingle: true, _Mode_ConstructorsAreAllNullary: true} 106 | , options: Options {tagSingleConstructors: false, allNullaryToStringTag: true} 107 | } -> jsonEmptyArray 108 | 109 | { mode: Mode {_Mode_ConstructorsAreAllNullary: true} 110 | , options: Options {allNullaryToStringTag: true} 111 | } -> encodeJson name 112 | 113 | { mode: Mode {_Mode_ConstructorIsSingle: true} 114 | , options: Options {tagSingleConstructors: false} 115 | } -> case encodeRepArgs arguments of 116 | Rec foreignObject -> fromObject foreignObject 117 | Arg xs -> case uncons xs of 118 | Nothing -> jsonEmptyArray 119 | Just {head: x, tail: ys} -> case uncons ys of 120 | Nothing -> x 121 | Just {head: y, tail: zs} -> fromArray ([x, y] <> zs) 122 | 123 | {options: Options {sumEncoding: TaggedObject taggedObject}} -> 124 | let o :: FO.Object Json 125 | o = FO.insert taggedObject.tagFieldName (fromString (reflectSymbol (Proxy :: Proxy name))) FO.empty 126 | in fromObject case encodeRepArgs arguments of 127 | Rec o' -> o `FO.union` o' 128 | Arg js 129 | | length js == 0 130 | -> o 131 | | length js == 1 132 | -> FO.insert taggedObject.contentsFieldName (unsafePartial fromJust $ head js) o 133 | | otherwise 134 | -> FO.insert taggedObject.contentsFieldName (fromArray js) o 135 | 136 | class EncodeRepArgs r where 137 | encodeRepArgs :: r -> RepArgsEncoding 138 | 139 | instance encodeRepArgsNoArguments :: EncodeRepArgs Rep.NoArguments where 140 | encodeRepArgs Rep.NoArguments = Arg [] 141 | 142 | instance encodeRepArgsProduct :: (EncodeRepArgs a, EncodeRepArgs b) => EncodeRepArgs (Rep.Product a b) where 143 | encodeRepArgs (Rep.Product a b) = encodeRepArgs a <> encodeRepArgs b 144 | 145 | instance encodeRepAesonArgsArgument :: EncodeJson a => EncodeRepArgs (Rep.Argument a) where 146 | encodeRepArgs (Rep.Argument a) = Arg [encodeJson a] 147 | 148 | 149 | -- | Encode record fields 150 | class EncodeRepFields (rs :: RowList Type) (row :: Row Type) | rs -> row where 151 | encodeFields :: Proxy rs -> Record row -> (FO.Object Json) 152 | 153 | instance encodeRepFieldsCons ∷ ( IsSymbol name 154 | , EncodeJson ty 155 | , Cons name ty tailRow row 156 | , EncodeRepFields tail row) ⇒ EncodeRepFields (Cons name ty tail) row where 157 | encodeFields _ r = 158 | let 159 | name = reflectSymbol (Proxy ∷ Proxy name) 160 | value = get (Proxy ∷ Proxy name) r 161 | 162 | rest ∷ FO.Object Json 163 | rest = encodeFields (Proxy ∷ Proxy tail) r 164 | in 165 | FO.insert name (encodeJson value) rest 166 | 167 | instance encodeRepFieldsNil ∷ EncodeRepFields Nil row where 168 | encodeFields _ _ = FO.empty 169 | 170 | -- | Encode any `Generic` data structure into `Json` using `Aeson` encoding 171 | genericEncodeAeson :: forall a r. Rep.Generic a r => EncodeAeson r => Options -> a -> Json 172 | genericEncodeAeson o = encodeAeson o <<< Rep.from 173 | -------------------------------------------------------------------------------- /src/Data/Argonaut/Aeson/Helpers.purs: -------------------------------------------------------------------------------- 1 | module Data.Argonaut.Aeson.Helpers where 2 | 3 | import Prelude ((&&)) 4 | 5 | import Data.Generic.Rep as Rep 6 | import Type.Proxy (Proxy(..)) 7 | 8 | class IsSingleConstructor r where 9 | isSingleConstructor :: Proxy r -> Boolean 10 | 11 | instance isSingleConstructor_NoConstructors :: IsSingleConstructor Rep.NoConstructors where 12 | isSingleConstructor _ = false 13 | 14 | instance isSingleConstructor_Sum :: IsSingleConstructor (Rep.Sum a b) 15 | where 16 | isSingleConstructor _ = false 17 | 18 | instance isSingleConstructor_Constructor :: IsSingleConstructor (Rep.Constructor name value) where 19 | isSingleConstructor _ = true 20 | 21 | class AreAllConstructorsNullary r where 22 | areAllConstructorsNullary :: Proxy r -> Boolean 23 | 24 | instance areAllConstructorsNullary_NoConstructors :: AreAllConstructorsNullary Rep.NoConstructors where 25 | areAllConstructorsNullary _ = true 26 | 27 | instance areAllConstructorsNullary_Sum 28 | :: (AreAllConstructorsNullary a, AreAllConstructorsNullary b) 29 | => AreAllConstructorsNullary (Rep.Sum a b) where 30 | areAllConstructorsNullary _ = areAllConstructorsNullary (Proxy :: Proxy a) && areAllConstructorsNullary (Proxy :: Proxy b) 31 | 32 | instance areAllConstructorsNullary_Constructor 33 | :: AreAllConstructorsNullary value 34 | => AreAllConstructorsNullary (Rep.Constructor name value) where 35 | areAllConstructorsNullary _ = areAllConstructorsNullary (Proxy :: Proxy value) 36 | 37 | instance areAllConstructorsNullary_NoArguments :: AreAllConstructorsNullary Rep.NoArguments where 38 | areAllConstructorsNullary _ = true 39 | 40 | instance areAllConstructorsNullary_Argument :: AreAllConstructorsNullary (Rep.Argument a) where 41 | areAllConstructorsNullary _ = false 42 | 43 | instance areAllConstructorsNullary_Product :: AreAllConstructorsNullary (Rep.Product a b) where 44 | areAllConstructorsNullary _ = false 45 | 46 | data Mode = Mode 47 | { _Mode_ConstructorIsSingle :: Boolean 48 | , _Mode_ConstructorsAreAllNullary :: Boolean 49 | } 50 | -------------------------------------------------------------------------------- /src/Data/Argonaut/Aeson/Options.purs: -------------------------------------------------------------------------------- 1 | module Data.Argonaut.Aeson.Options 2 | ( SumEncoding(..) 3 | , Options(Options) 4 | , defaultOptions 5 | ) where 6 | 7 | import Prelude (class Show) 8 | 9 | import Data.Generic.Rep (class Generic) 10 | import Data.Show.Generic (genericShow) 11 | 12 | data SumEncoding 13 | = TaggedObject { tagFieldName :: String, contentsFieldName :: String } 14 | 15 | derive instance generic_SumEncoding :: Generic SumEncoding _ 16 | 17 | instance show_SumEncoding ::Show SumEncoding where 18 | show = genericShow 19 | 20 | newtype Options = Options 21 | { sumEncoding :: SumEncoding 22 | , tagSingleConstructors ∷ Boolean 23 | , allNullaryToStringTag :: Boolean 24 | } 25 | 26 | derive instance generic_Options :: Generic Options _ 27 | 28 | instance show_Options ::Show Options where 29 | show = genericShow 30 | 31 | defaultOptions :: Options 32 | defaultOptions = Options 33 | { sumEncoding: TaggedObject { tagFieldName: "tag", contentsFieldName: "contents" } 34 | , tagSingleConstructors: false 35 | , allNullaryToStringTag: true 36 | } 37 | -------------------------------------------------------------------------------- /test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Effect (Effect) 4 | import Data.Argonaut.Aeson.Decode.Generic (genericDecodeAeson, class DecodeAeson) 5 | import Data.Argonaut.Aeson.Encode.Generic (genericEncodeAeson, class EncodeAeson) 6 | import Data.Argonaut.Aeson.Options (Options(..), SumEncoding(..), defaultOptions) 7 | import Data.Argonaut.Decode.Class (class DecodeJson) 8 | import Data.Argonaut.Encode.Class (class EncodeJson) 9 | import Data.Argonaut.Decode.Error (JsonDecodeError(TypeMismatch), printJsonDecodeError) 10 | import Data.Argonaut.Core (stringify) 11 | import Data.Argonaut.Parser (jsonParser) 12 | import Data.Either (Either(..), either) 13 | import Data.Foldable (traverse_) 14 | import Data.Generic.Rep (class Generic) 15 | import Data.Show.Generic (genericShow) 16 | import Prelude (class Eq, class Show, Unit, discard, show, map, ($), (<>), (<<<), (<=<)) 17 | import Test.Unit (suite, test, TestSuite) 18 | import Test.Unit.Assert as Assert 19 | import Test.Unit.Main (runTest) 20 | 21 | handleJsonDecodeError 22 | :: forall a 23 | . Either JsonDecodeError a 24 | -> Either String a 25 | handleJsonDecodeError = 26 | either (\l -> Left (printJsonDecodeError l)) (\r -> Right r) 27 | 28 | defaultOptionsWithTagSingleConstructorsAndNoAllNullaryToStringTag :: Options 29 | defaultOptionsWithTagSingleConstructorsAndNoAllNullaryToStringTag = Options 30 | { sumEncoding: TaggedObject { tagFieldName: "tag", contentsFieldName: "contents" } 31 | , tagSingleConstructors: true 32 | , allNullaryToStringTag: false 33 | } 34 | 35 | defaultOptionsWithNoAllNullaryToStringTag :: Options 36 | defaultOptionsWithNoAllNullaryToStringTag = Options 37 | { sumEncoding: TaggedObject { tagFieldName: "tag", contentsFieldName: "contents" } 38 | , tagSingleConstructors: false 39 | , allNullaryToStringTag: false 40 | } 41 | 42 | defaultOptionsWithTagSingleConstructors :: Options 43 | defaultOptionsWithTagSingleConstructors = Options 44 | { sumEncoding: TaggedObject { tagFieldName: "tag", contentsFieldName: "contents" } 45 | , tagSingleConstructors: true 46 | , allNullaryToStringTag: true 47 | } 48 | 49 | wrapError :: forall r. Either String r -> Either JsonDecodeError r 50 | wrapError (Left e) = Left $ TypeMismatch e 51 | wrapError (Right r) = Right r 52 | 53 | checkAesonCompatibility :: forall a rep. Eq a => Show a => Generic a rep => DecodeAeson rep => a -> String -> Options -> TestSuite 54 | checkAesonCompatibility value canonicalEncoding options = 55 | test (show value <> " as " <> canonicalEncoding) do 56 | let hopefullyDecodedValue = (genericDecodeAeson options <=< wrapError <<< jsonParser) canonicalEncoding 57 | Assert.equal (Right value) hopefullyDecodedValue 58 | 59 | checkManyWithOptions :: Options -> Array (Options -> TestSuite) -> TestSuite 60 | checkManyWithOptions options testCaseConstructors = suite (show options) (traverse_ (_$ options) testCaseConstructors) 61 | 62 | checkInvertibility :: forall a rep. Eq a => Show a => Generic a rep => EncodeAeson rep => DecodeAeson rep => a -> Options -> TestSuite 63 | checkInvertibility value options = 64 | let encoding = (stringify <<< genericEncodeAeson options) value 65 | hopefullyDecodedValue = (genericDecodeAeson options <=< wrapError <<< jsonParser) encoding 66 | in test (show value <> " as " <> encoding) do Assert.equal (Right value) hopefullyDecodedValue 67 | 68 | data SingleNullary = SingleNullary 69 | derive instance generic_SingleNullary :: Generic SingleNullary _ 70 | instance show_SingleNullary :: Show SingleNullary where show = genericShow 71 | derive instance eq_SingleNullary :: Eq SingleNullary 72 | 73 | data SingleUnary = SingleUnary Int 74 | derive instance generic_SingleUnary :: Generic SingleUnary _ 75 | instance show_SingleUnary :: Show SingleUnary where show = genericShow 76 | derive instance eq_SingleUnary :: Eq SingleUnary 77 | 78 | data SingleBinary = SingleBinary Int Int 79 | derive instance generic_SingleBinary :: Generic SingleBinary _ 80 | instance show_SingleBinary :: Show SingleBinary where show = genericShow 81 | derive instance eq_SingleBinary :: Eq SingleBinary 82 | 83 | data RecordUnary = RecordUnary {recordUnaryField1 :: Int} 84 | derive instance generic_RecordUnary :: Generic RecordUnary _ 85 | instance show_RecordUnary :: Show RecordUnary where show = genericShow 86 | derive instance eq_RecordUnary :: Eq RecordUnary 87 | 88 | data RecordBinary = RecordBinary {recordBinaryField1 :: Int, recordBinaryField2 :: Int} 89 | derive instance generic_RecordBinary :: Generic RecordBinary _ 90 | instance show_RecordBinary :: Show RecordBinary where show = genericShow 91 | derive instance eq_RecordBinary :: Eq RecordBinary 92 | 93 | data Enumeration = Enumeration1 | Enumeration2 | Enumeration3 94 | derive instance generic_Enumeration :: Generic Enumeration _ 95 | instance show_Enumeration :: Show Enumeration where show = genericShow 96 | derive instance eq_Enumeration :: Eq Enumeration 97 | 98 | data Variety = VarietyNullary | VarietyUnary Int | VarietyBinary Int Int 99 | derive instance generic_Variety :: Generic Variety _ 100 | instance show_Variety :: Show Variety where show = genericShow 101 | derive instance eq_Variety :: Eq Variety 102 | 103 | data Nested a = Nested a 104 | derive instance generic_Nested :: Generic (Nested a) _ 105 | instance show_Nested :: Show a => Show (Nested a) where show = genericShow 106 | derive instance eq_Nested :: Eq a => Eq (Nested a) 107 | instance decodeJsonNested :: DecodeJson a => DecodeJson (Nested a) where 108 | decodeJson a = genericDecodeAeson defaultOptions a 109 | instance encodeJsonNested :: EncodeJson a => EncodeJson (Nested a) where 110 | encodeJson a = genericEncodeAeson defaultOptions a 111 | 112 | data Siblings a b = Siblings a b 113 | derive instance generic_Siblings :: Generic (Siblings a b) _ 114 | instance show_Siblings :: (Show a, Show b) => Show (Siblings a b) where show = genericShow 115 | derive instance eq_Siblings :: (Eq a, Eq b) => Eq (Siblings a b) 116 | instance decodeJsonSiblings :: (DecodeJson a, DecodeJson b) => DecodeJson (Siblings a b) where 117 | decodeJson a = genericDecodeAeson defaultOptions a 118 | instance encodeJsonSiblings :: (EncodeJson a, EncodeJson b) => EncodeJson (Siblings a b) where 119 | encodeJson a = genericEncodeAeson defaultOptions a 120 | 121 | data Trinity a b c = Trinity a b c 122 | derive instance generic_Trinity :: Generic (Trinity a b c) _ 123 | instance show_Trinity :: (Show a, Show b, Show c) => Show (Trinity a b c) where show = genericShow 124 | derive instance eq_Trinity :: (Eq a, Eq b, Eq c) => Eq (Trinity a b c) 125 | instance decodeJsonTrinity :: (DecodeJson a, DecodeJson b, DecodeJson c) => DecodeJson (Trinity a b c) where 126 | decodeJson a = genericDecodeAeson defaultOptions a 127 | instance encodeJsonTrinity :: (EncodeJson a, EncodeJson b, EncodeJson c) => EncodeJson (Trinity a b c) where 128 | encodeJson a = genericEncodeAeson defaultOptions a 129 | 130 | data Inner = Inner 131 | derive instance generic_Inner :: Generic Inner _ 132 | instance show_Inner :: Show Inner where show = genericShow 133 | derive instance eq_Inner :: Eq Inner 134 | instance decodeJsonInner :: DecodeJson Inner where 135 | decodeJson a = genericDecodeAeson defaultOptions a 136 | instance encodeJsonInner :: EncodeJson Inner where 137 | encodeJson a = genericEncodeAeson defaultOptions a 138 | 139 | data InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag = InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag 140 | derive instance generic_InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag :: Generic InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag _ 141 | instance show_InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag :: Show InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag where show = genericShow 142 | derive instance eq_InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag :: Eq InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag 143 | instance decodeJsonInnerWithTagSingleConstructorsAndNoAllNullaryToStringTag :: DecodeJson InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag where 144 | decodeJson a = genericDecodeAeson defaultOptionsWithTagSingleConstructorsAndNoAllNullaryToStringTag a 145 | instance encodeJsonInnerWithTagSingleConstructorsAndNoAllNullaryToStringTag :: EncodeJson InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag where 146 | encodeJson a = genericEncodeAeson defaultOptionsWithTagSingleConstructorsAndNoAllNullaryToStringTag a 147 | 148 | data InnerWithNoAllNullaryToStringTag = InnerWithNoAllNullaryToStringTag 149 | derive instance generic_InnerWithNoAllNullaryToStringTag :: Generic InnerWithNoAllNullaryToStringTag _ 150 | instance show_InnerWithNoAllNullaryToStringTag :: Show InnerWithNoAllNullaryToStringTag where show = genericShow 151 | derive instance eq_InnerWithNoAllNullaryToStringTag :: Eq InnerWithNoAllNullaryToStringTag 152 | instance decodeJsonInnerWithNoAllNullaryToStringTag :: DecodeJson InnerWithNoAllNullaryToStringTag where 153 | decodeJson a = genericDecodeAeson defaultOptionsWithNoAllNullaryToStringTag a 154 | instance encodeJsonInnerWithNoAllNullaryToStringTag :: EncodeJson InnerWithNoAllNullaryToStringTag where 155 | encodeJson a = genericEncodeAeson defaultOptionsWithNoAllNullaryToStringTag a 156 | 157 | data InnerWithTagSingleConstructors = InnerWithTagSingleConstructors 158 | derive instance generic_InnerWithTagSingleConstructors :: Generic InnerWithTagSingleConstructors _ 159 | instance show_InnerWithTagSingleConstructors :: Show InnerWithTagSingleConstructors where show = genericShow 160 | derive instance eq_InnerWithTagSingleConstructors :: Eq InnerWithTagSingleConstructors 161 | instance decodeJsonInnerWithTagSingleConstructors :: DecodeJson InnerWithTagSingleConstructors where 162 | decodeJson a = genericDecodeAeson defaultOptionsWithTagSingleConstructors a 163 | instance encodeJsonInnerWithTagSingleConstructors :: EncodeJson InnerWithTagSingleConstructors where 164 | encodeJson a = genericEncodeAeson defaultOptionsWithTagSingleConstructors a 165 | 166 | main :: Effect Unit 167 | main = runTest do 168 | suite "Aeson compatibility" do 169 | checkManyWithOptions defaultOptions 170 | [ checkAesonCompatibility SingleNullary "[]" 171 | , checkAesonCompatibility (SingleUnary 1) "1" 172 | , checkAesonCompatibility (SingleBinary 1 2) "[1,2]" 173 | , checkAesonCompatibility (RecordUnary {recordUnaryField1: 1}) "{\"recordUnaryField1\":1}" 174 | , checkAesonCompatibility (RecordBinary {recordBinaryField1: 1, recordBinaryField2: 2}) "{\"recordBinaryField1\":1,\"recordBinaryField2\":2}" 175 | , checkAesonCompatibility Enumeration1 "\"Enumeration1\"" 176 | , checkAesonCompatibility Enumeration2 "\"Enumeration2\"" 177 | , checkAesonCompatibility Enumeration3 "\"Enumeration3\"" 178 | , checkAesonCompatibility VarietyNullary "{\"tag\":\"VarietyNullary\"}" 179 | , checkAesonCompatibility (VarietyUnary 1) "{\"tag\":\"VarietyUnary\",\"contents\":1}" 180 | , checkAesonCompatibility (VarietyBinary 1 2) "{\"tag\":\"VarietyBinary\",\"contents\":[1,2]}" 181 | , checkAesonCompatibility (Nested Inner) "[]" 182 | , checkAesonCompatibility (Nested ([ ] :: Array Inner)) "[]" 183 | , checkAesonCompatibility (Nested [Inner]) "[[]]" 184 | , checkAesonCompatibility (Nested [Inner,Inner]) "[[],[]]" 185 | , checkAesonCompatibility (Nested InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag) "{\"tag\":\"InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag\"}" 186 | , checkAesonCompatibility (Nested ([ ] :: Array InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag)) "[]" 187 | , checkAesonCompatibility (Nested [InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag]) "[{\"tag\":\"InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag\"}]" 188 | , checkAesonCompatibility (Nested [InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag,InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag]) "[{\"tag\":\"InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag\"},{\"tag\":\"InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag\"}]" 189 | , checkAesonCompatibility (Nested InnerWithNoAllNullaryToStringTag) "[]" 190 | , checkAesonCompatibility (Nested ([ ] :: Array InnerWithNoAllNullaryToStringTag)) "[]" 191 | , checkAesonCompatibility (Nested [InnerWithNoAllNullaryToStringTag]) "[[]]" 192 | , checkAesonCompatibility (Nested [InnerWithNoAllNullaryToStringTag,InnerWithNoAllNullaryToStringTag]) "[[],[]]" 193 | , checkAesonCompatibility (Nested InnerWithTagSingleConstructors) "\"InnerWithTagSingleConstructors\"" 194 | , checkAesonCompatibility (Nested ([ ] :: Array InnerWithTagSingleConstructors)) "[]" 195 | , checkAesonCompatibility (Nested [InnerWithTagSingleConstructors]) "[\"InnerWithTagSingleConstructors\"]" 196 | , checkAesonCompatibility (Nested [InnerWithTagSingleConstructors,InnerWithTagSingleConstructors]) "[\"InnerWithTagSingleConstructors\",\"InnerWithTagSingleConstructors\"]" 197 | , checkAesonCompatibility (Siblings (Nested Inner) InnerWithNoAllNullaryToStringTag) "[[],[]]" 198 | , checkAesonCompatibility (Siblings (Nested (Siblings (Nested InnerWithTagSingleConstructors) "meow")) 3.1415927) "[[\"InnerWithTagSingleConstructors\",\"meow\"],3.1415927]" 199 | , checkAesonCompatibility (Trinity 3.1415927 (Nested (Nested (Siblings InnerWithNoAllNullaryToStringTag InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag))) ["oink","waff","quack"]) "[3.1415927,[[],{\"tag\":\"InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag\"}],[\"oink\",\"waff\",\"quack\"]]" 200 | ] 201 | checkManyWithOptions defaultOptionsWithNoAllNullaryToStringTag 202 | [ checkAesonCompatibility SingleNullary "[]" 203 | , checkAesonCompatibility (SingleUnary 1) "1" 204 | , checkAesonCompatibility (SingleBinary 1 2) "[1,2]" 205 | , checkAesonCompatibility (RecordUnary {recordUnaryField1: 1}) "{\"recordUnaryField1\":1}" 206 | , checkAesonCompatibility (RecordBinary {recordBinaryField1: 1, recordBinaryField2: 2}) "{\"recordBinaryField1\":1,\"recordBinaryField2\":2}" 207 | , checkAesonCompatibility Enumeration1 "{\"tag\":\"Enumeration1\"}" 208 | , checkAesonCompatibility Enumeration2 "{\"tag\":\"Enumeration2\"}" 209 | , checkAesonCompatibility Enumeration3 "{\"tag\":\"Enumeration3\"}" 210 | , checkAesonCompatibility VarietyNullary "{\"tag\":\"VarietyNullary\"}" 211 | , checkAesonCompatibility (VarietyUnary 1) "{\"tag\":\"VarietyUnary\",\"contents\":1}" 212 | , checkAesonCompatibility (VarietyBinary 1 2) "{\"tag\":\"VarietyBinary\",\"contents\":[1,2]}" 213 | , checkAesonCompatibility (Nested Inner) "[]" 214 | , checkAesonCompatibility (Nested ([ ] :: Array Inner)) "[]" 215 | , checkAesonCompatibility (Nested [Inner]) "[[]]" 216 | , checkAesonCompatibility (Nested [Inner,Inner]) "[[],[]]" 217 | , checkAesonCompatibility (Nested InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag) "{\"tag\":\"InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag\"}" 218 | , checkAesonCompatibility (Nested ([ ] :: Array InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag)) "[]" 219 | , checkAesonCompatibility (Nested [InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag]) "[{\"tag\":\"InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag\"}]" 220 | , checkAesonCompatibility (Nested [InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag,InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag]) "[{\"tag\":\"InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag\"},{\"tag\":\"InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag\"}]" 221 | , checkAesonCompatibility (Nested InnerWithNoAllNullaryToStringTag) "[]" 222 | , checkAesonCompatibility (Nested ([ ] :: Array InnerWithNoAllNullaryToStringTag)) "[]" 223 | , checkAesonCompatibility (Nested [InnerWithNoAllNullaryToStringTag]) "[[]]" 224 | , checkAesonCompatibility (Nested [InnerWithNoAllNullaryToStringTag,InnerWithNoAllNullaryToStringTag]) "[[],[]]" 225 | , checkAesonCompatibility (Nested InnerWithTagSingleConstructors) "\"InnerWithTagSingleConstructors\"" 226 | , checkAesonCompatibility (Nested ([ ] :: Array InnerWithTagSingleConstructors)) "[]" 227 | , checkAesonCompatibility (Nested [InnerWithTagSingleConstructors]) "[\"InnerWithTagSingleConstructors\"]" 228 | , checkAesonCompatibility (Nested [InnerWithTagSingleConstructors,InnerWithTagSingleConstructors]) "[\"InnerWithTagSingleConstructors\",\"InnerWithTagSingleConstructors\"]" 229 | , checkAesonCompatibility (Siblings (Nested Inner) InnerWithNoAllNullaryToStringTag) "[[],[]]" 230 | , checkAesonCompatibility (Siblings (Nested (Siblings (Nested InnerWithTagSingleConstructors) "meow")) 3.1415927) "[[\"InnerWithTagSingleConstructors\",\"meow\"],3.1415927]" 231 | , checkAesonCompatibility (Trinity 3.1415927 (Nested (Nested (Siblings InnerWithNoAllNullaryToStringTag InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag))) ["oink","waff","quack"]) "[3.1415927,[[],{\"tag\":\"InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag\"}],[\"oink\",\"waff\",\"quack\"]]" 232 | ] 233 | checkManyWithOptions defaultOptionsWithTagSingleConstructors 234 | [ checkAesonCompatibility SingleNullary "\"SingleNullary\"" 235 | , checkAesonCompatibility (SingleUnary 1) "{\"tag\":\"SingleUnary\",\"contents\":1}" 236 | , checkAesonCompatibility (SingleBinary 1 2) "{\"tag\":\"SingleBinary\",\"contents\":[1,2]}" 237 | , checkAesonCompatibility (RecordUnary {recordUnaryField1: 1}) "{\"recordUnaryField1\":1,\"tag\":\"RecordUnary\"}" 238 | , checkAesonCompatibility (RecordBinary {recordBinaryField1: 1, recordBinaryField2: 2}) "{\"tag\":\"RecordBinary\",\"recordBinaryField1\":1,\"recordBinaryField2\":2}" 239 | , checkAesonCompatibility Enumeration1 "\"Enumeration1\"" 240 | , checkAesonCompatibility Enumeration2 "\"Enumeration2\"" 241 | , checkAesonCompatibility Enumeration3 "\"Enumeration3\"" 242 | , checkAesonCompatibility VarietyNullary "{\"tag\":\"VarietyNullary\"}" 243 | , checkAesonCompatibility (VarietyUnary 1) "{\"tag\":\"VarietyUnary\",\"contents\":1}" 244 | , checkAesonCompatibility (VarietyBinary 1 2) "{\"tag\":\"VarietyBinary\",\"contents\":[1,2]}" 245 | , checkAesonCompatibility (Nested Inner) "{\"tag\":\"Nested\",\"contents\":[]}" 246 | , checkAesonCompatibility (Nested ([ ] :: Array Inner)) "{\"tag\":\"Nested\",\"contents\":[]}" 247 | , checkAesonCompatibility (Nested [Inner]) "{\"tag\":\"Nested\",\"contents\":[[]]}" 248 | , checkAesonCompatibility (Nested [Inner,Inner]) "{\"tag\":\"Nested\",\"contents\":[[],[]]}" 249 | , checkAesonCompatibility (Nested InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag) "{\"tag\":\"Nested\",\"contents\":{\"tag\":\"InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag\"}}" 250 | , checkAesonCompatibility (Nested ([ ] :: Array InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag)) "{\"tag\":\"Nested\",\"contents\":[]}" 251 | , checkAesonCompatibility (Nested [InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag]) "{\"tag\":\"Nested\",\"contents\":[{\"tag\":\"InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag\"}]}" 252 | , checkAesonCompatibility (Nested [InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag,InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag]) "{\"tag\":\"Nested\",\"contents\":[{\"tag\":\"InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag\"},{\"tag\":\"InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag\"}]}" 253 | , checkAesonCompatibility (Nested InnerWithNoAllNullaryToStringTag) "{\"tag\":\"Nested\",\"contents\":[]}" 254 | , checkAesonCompatibility (Nested ([ ] :: Array InnerWithNoAllNullaryToStringTag)) "{\"tag\":\"Nested\",\"contents\":[]}" 255 | , checkAesonCompatibility (Nested [InnerWithNoAllNullaryToStringTag]) "{\"tag\":\"Nested\",\"contents\":[[]]}" 256 | , checkAesonCompatibility (Nested [InnerWithNoAllNullaryToStringTag,InnerWithNoAllNullaryToStringTag]) "{\"tag\":\"Nested\",\"contents\":[[],[]]}" 257 | , checkAesonCompatibility (Nested InnerWithTagSingleConstructors) "{\"tag\":\"Nested\",\"contents\":\"InnerWithTagSingleConstructors\"}" 258 | , checkAesonCompatibility (Nested ([ ] :: Array InnerWithTagSingleConstructors)) "{\"tag\":\"Nested\",\"contents\":[]}" 259 | , checkAesonCompatibility (Nested [InnerWithTagSingleConstructors]) "{\"tag\":\"Nested\",\"contents\":[\"InnerWithTagSingleConstructors\"]}" 260 | , checkAesonCompatibility (Nested [InnerWithTagSingleConstructors,InnerWithTagSingleConstructors]) "{\"tag\":\"Nested\",\"contents\":[\"InnerWithTagSingleConstructors\",\"InnerWithTagSingleConstructors\"]}" 261 | , checkAesonCompatibility (Siblings (Nested Inner) InnerWithNoAllNullaryToStringTag) "{\"tag\":\"Siblings\",\"contents\":[[],[]]}" 262 | , checkAesonCompatibility (Siblings (Nested (Siblings (Nested InnerWithTagSingleConstructors) "meow")) 3.1415927) "{\"tag\":\"Siblings\",\"contents\":[[\"InnerWithTagSingleConstructors\",\"meow\"],3.1415927]}" 263 | , checkAesonCompatibility (Trinity 3.1415927 (Nested (Nested (Siblings InnerWithNoAllNullaryToStringTag InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag))) ["oink","waff","quack"]) "{\"tag\":\"Trinity\",\"contents\":[3.1415927,[[],{\"tag\":\"InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag\"}],[\"oink\",\"waff\",\"quack\"]]}" 264 | ] 265 | checkManyWithOptions defaultOptionsWithTagSingleConstructorsAndNoAllNullaryToStringTag 266 | [ checkAesonCompatibility SingleNullary "{\"tag\":\"SingleNullary\"}" 267 | , checkAesonCompatibility (SingleUnary 1) "{\"tag\":\"SingleUnary\",\"contents\":1}" 268 | , checkAesonCompatibility (SingleBinary 1 2) "{\"tag\":\"SingleBinary\",\"contents\":[1,2]}" 269 | , checkAesonCompatibility (RecordUnary {recordUnaryField1: 1}) "{\"recordUnaryField1\":1,\"tag\":\"RecordUnary\"}" 270 | , checkAesonCompatibility (RecordBinary {recordBinaryField1: 1, recordBinaryField2: 2}) "{\"tag\":\"RecordBinary\",\"recordBinaryField1\":1,\"recordBinaryField2\":2}" 271 | , checkAesonCompatibility Enumeration1 "{\"tag\":\"Enumeration1\"}" 272 | , checkAesonCompatibility Enumeration2 "{\"tag\":\"Enumeration2\"}" 273 | , checkAesonCompatibility Enumeration3 "{\"tag\":\"Enumeration3\"}" 274 | , checkAesonCompatibility VarietyNullary "{\"tag\":\"VarietyNullary\"}" 275 | , checkAesonCompatibility (VarietyUnary 1) "{\"tag\":\"VarietyUnary\",\"contents\":1}" 276 | , checkAesonCompatibility (VarietyBinary 1 2) "{\"tag\":\"VarietyBinary\",\"contents\":[1,2]}" 277 | , checkAesonCompatibility (Nested Inner) "{\"tag\":\"Nested\",\"contents\":[]}" 278 | , checkAesonCompatibility (Nested ([ ] :: Array Inner)) "{\"tag\":\"Nested\",\"contents\":[]}" 279 | , checkAesonCompatibility (Nested [Inner]) "{\"tag\":\"Nested\",\"contents\":[[]]}" 280 | , checkAesonCompatibility (Nested [Inner,Inner]) "{\"tag\":\"Nested\",\"contents\":[[],[]]}" 281 | , checkAesonCompatibility (Nested InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag) "{\"tag\":\"Nested\",\"contents\":{\"tag\":\"InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag\"}}" 282 | , checkAesonCompatibility (Nested ([ ] :: Array InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag)) "{\"tag\":\"Nested\",\"contents\":[]}" 283 | , checkAesonCompatibility (Nested [InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag]) "{\"tag\":\"Nested\",\"contents\":[{\"tag\":\"InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag\"}]}" 284 | , checkAesonCompatibility (Nested [InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag,InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag]) "{\"tag\":\"Nested\",\"contents\":[{\"tag\":\"InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag\"},{\"tag\":\"InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag\"}]}" 285 | , checkAesonCompatibility (Nested InnerWithNoAllNullaryToStringTag) "{\"tag\":\"Nested\",\"contents\":[]}" 286 | , checkAesonCompatibility (Nested ([ ] :: Array InnerWithNoAllNullaryToStringTag)) "{\"tag\":\"Nested\",\"contents\":[]}" 287 | , checkAesonCompatibility (Nested [InnerWithNoAllNullaryToStringTag]) "{\"tag\":\"Nested\",\"contents\":[[]]}" 288 | , checkAesonCompatibility (Nested [InnerWithNoAllNullaryToStringTag,InnerWithNoAllNullaryToStringTag]) "{\"tag\":\"Nested\",\"contents\":[[],[]]}" 289 | , checkAesonCompatibility (Nested InnerWithTagSingleConstructors) "{\"tag\":\"Nested\",\"contents\":\"InnerWithTagSingleConstructors\"}" 290 | , checkAesonCompatibility (Nested ([ ] :: Array InnerWithTagSingleConstructors)) "{\"tag\":\"Nested\",\"contents\":[]}" 291 | , checkAesonCompatibility (Nested [InnerWithTagSingleConstructors]) "{\"tag\":\"Nested\",\"contents\":[\"InnerWithTagSingleConstructors\"]}" 292 | , checkAesonCompatibility (Nested [InnerWithTagSingleConstructors,InnerWithTagSingleConstructors]) "{\"tag\":\"Nested\",\"contents\":[\"InnerWithTagSingleConstructors\",\"InnerWithTagSingleConstructors\"]}" 293 | , checkAesonCompatibility (Siblings (Nested Inner) InnerWithNoAllNullaryToStringTag) "{\"tag\":\"Siblings\",\"contents\":[[],[]]}" 294 | , checkAesonCompatibility (Siblings (Nested (Siblings (Nested InnerWithTagSingleConstructors) "meow")) 3.1415927) "{\"tag\":\"Siblings\",\"contents\":[[\"InnerWithTagSingleConstructors\",\"meow\"],3.1415927]}" 295 | , checkAesonCompatibility (Trinity 3.1415927 (Nested (Nested (Siblings InnerWithNoAllNullaryToStringTag InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag))) ["oink","waff","quack"]) "{\"tag\":\"Trinity\",\"contents\":[3.1415927,[[],{\"tag\":\"InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag\"}],[\"oink\",\"waff\",\"quack\"]]}" 296 | ] 297 | suite "Invertibility" 298 | let examples = 299 | [ checkInvertibility SingleNullary 300 | , checkInvertibility (SingleUnary 1) 301 | , checkInvertibility (SingleBinary 1 2) 302 | , checkInvertibility (RecordUnary {recordUnaryField1: 1}) 303 | , checkInvertibility (RecordBinary {recordBinaryField1: 1, recordBinaryField2: 2}) 304 | , checkInvertibility Enumeration1 305 | , checkInvertibility Enumeration2 306 | , checkInvertibility Enumeration3 307 | , checkInvertibility VarietyNullary 308 | , checkInvertibility (VarietyUnary 1) 309 | , checkInvertibility (VarietyBinary 1 2) 310 | , checkInvertibility Inner 311 | , checkInvertibility (Nested Inner) 312 | , checkInvertibility (Nested ([ ] :: Array Inner)) 313 | , checkInvertibility (Nested [Inner]) 314 | , checkInvertibility (Nested [Inner, Inner]) 315 | , checkInvertibility (Nested InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag) 316 | , checkInvertibility (Nested ([ ] :: Array InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag)) 317 | , checkInvertibility (Nested [InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag]) 318 | , checkInvertibility (Nested [InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag, InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag]) 319 | , checkInvertibility (Nested InnerWithNoAllNullaryToStringTag) 320 | , checkInvertibility (Nested ([ ] :: Array InnerWithNoAllNullaryToStringTag)) 321 | , checkInvertibility (Nested [InnerWithNoAllNullaryToStringTag]) 322 | , checkInvertibility (Nested [InnerWithNoAllNullaryToStringTag, InnerWithNoAllNullaryToStringTag]) 323 | , checkInvertibility (Nested InnerWithTagSingleConstructors) 324 | , checkInvertibility (Nested ([ ] :: Array InnerWithTagSingleConstructors)) 325 | , checkInvertibility (Nested [InnerWithTagSingleConstructors]) 326 | , checkInvertibility (Nested [InnerWithTagSingleConstructors, InnerWithTagSingleConstructors]) 327 | , checkInvertibility (Siblings (Nested Inner) InnerWithNoAllNullaryToStringTag) 328 | , checkInvertibility (Siblings (Nested (Siblings (Nested InnerWithTagSingleConstructors) "meow")) 3.1415927) 329 | , checkInvertibility (Trinity 3.1415927 (Nested (Nested (Siblings InnerWithNoAllNullaryToStringTag InnerWithTagSingleConstructorsAndNoAllNullaryToStringTag))) ["oink","waff","quack"]) 330 | ] 331 | options = 332 | [ defaultOptions 333 | , defaultOptionsWithNoAllNullaryToStringTag 334 | , defaultOptionsWithTagSingleConstructors 335 | , defaultOptionsWithTagSingleConstructorsAndNoAllNullaryToStringTag 336 | ] 337 | in do traverse_ (_ $ examples) (map checkManyWithOptions options) 338 | --------------------------------------------------------------------------------