├── .editorconfig ├── .github ├── ISSUE_TEMPLATE │ ├── bug-report.md │ ├── change-request.md │ └── config.yml ├── PULL_REQUEST_TEMPLATE.md └── workflows │ └── ci.yml ├── .gitignore ├── .tidyrc.json ├── CHANGELOG.md ├── CONTRIBUTING.md ├── LICENSE ├── README.md ├── bower.json ├── docs └── README.md ├── packages.dhall ├── spago.dhall ├── src └── Data │ └── Argonaut │ ├── Decode.purs │ ├── Decode │ ├── Class.purs │ ├── Combinators.purs │ ├── Decoders.purs │ ├── Error.purs │ └── Parser.purs │ ├── Encode.purs │ └── Encode │ ├── Class.purs │ ├── Combinators.purs │ └── Encoders.purs └── test └── Test └── Main.purs /.editorconfig: -------------------------------------------------------------------------------- 1 | # http://editorconfig.org 2 | root = true 3 | 4 | [*] 5 | indent_style = space 6 | indent_size = 2 7 | end_of_line = lf 8 | charset = utf-8 9 | trim_trailing_whitespace = true 10 | insert_final_newline = true 11 | 12 | [*.md] 13 | trim_trailing_whitespace = false 14 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/bug-report.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Bug report 3 | about: Report an issue 4 | title: "" 5 | labels: bug 6 | assignees: "" 7 | --- 8 | 9 | **Describe the bug** 10 | A clear and concise description of the bug. 11 | 12 | **To Reproduce** 13 | A minimal code example (preferably a runnable example on [Try PureScript](https://try.purescript.org)!) or steps to reproduce the issue. 14 | 15 | **Expected behavior** 16 | A clear and concise description of what you expected to happen. 17 | 18 | **Additional context** 19 | Add any other context about the problem here. 20 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/change-request.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Change request 3 | about: Propose an improvement to this library 4 | title: "" 5 | labels: "" 6 | assignees: "" 7 | --- 8 | 9 | **Is your change request related to a problem? Please describe.** 10 | A clear and concise description of the problem. 11 | 12 | Examples: 13 | 14 | - It's frustrating to have to [...] 15 | - I was looking for a function to [...] 16 | 17 | **Describe the solution you'd like** 18 | A clear and concise description of what a good solution to you looks like, including any solutions you've already considered. 19 | 20 | **Additional context** 21 | Add any other context about the change request here. 22 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/config.yml: -------------------------------------------------------------------------------- 1 | blank_issues_enabled: false 2 | contact_links: 3 | - name: PureScript Discourse 4 | url: https://discourse.purescript.org/ 5 | about: Ask and answer questions on the PureScript discussion forum. 6 | - name: PureScript Discord 7 | url: https://purescript.org/chat 8 | about: Ask and answer questions on the PureScript chat. 9 | -------------------------------------------------------------------------------- /.github/PULL_REQUEST_TEMPLATE.md: -------------------------------------------------------------------------------- 1 | **Description of the change** 2 | Clearly and concisely describe the purpose of the pull request. If this PR relates to an existing issue or change proposal, please link to it. Include any other background context that would help reviewers understand the motivation for this PR. 3 | 4 | --- 5 | 6 | **Checklist:** 7 | 8 | - [ ] Added the change to the changelog's "Unreleased" section with a link to this PR and your username 9 | - [ ] Linked any existing issues or proposals that this pull request should close 10 | - [ ] Updated or added relevant documentation in the README and/or documentation directory 11 | - [ ] Added a test for the contribution (if applicable) 12 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | branches: [main] 6 | pull_request: 7 | branches: [main] 8 | 9 | jobs: 10 | build: 11 | runs-on: ubuntu-latest 12 | 13 | steps: 14 | - uses: actions/checkout@v4 15 | 16 | - name: Set up a PureScript toolchain 17 | uses: purescript-contrib/setup-purescript@main 18 | with: 19 | purescript: "unstable" 20 | purs-tidy: "latest" 21 | 22 | - name: Cache PureScript dependencies 23 | uses: actions/cache@v4 24 | with: 25 | key: ${{ runner.os }}-spago-${{ hashFiles('**/*.dhall') }} 26 | path: | 27 | .spago 28 | output 29 | 30 | - name: Install dependencies 31 | run: spago install 32 | 33 | - name: Build source 34 | run: spago build --no-install --purs-args '--censor-lib --strict' 35 | 36 | - name: Run tests 37 | run: spago test --no-install 38 | 39 | - name: Check formatting 40 | run: purs-tidy check src test 41 | 42 | - name: Verify Bower & Pulp 43 | run: | 44 | npm install bower pulp@16.0.0-0 45 | npx bower install 46 | npx pulp build 47 | if [ -d "test" ]; then 48 | npx pulp test 49 | fi 50 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .* 2 | !.gitignore 3 | !.github 4 | !.editorconfig 5 | !.tidyrc.json 6 | 7 | output 8 | generated-docs 9 | bower_components 10 | -------------------------------------------------------------------------------- /.tidyrc.json: -------------------------------------------------------------------------------- 1 | { 2 | "importSort": "source", 3 | "importWrap": "source", 4 | "indent": 2, 5 | "operatorsFile": null, 6 | "ribbon": 1, 7 | "typeArrowPlacement": "first", 8 | "unicode": "never", 9 | "width": null 10 | } 11 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | Notable changes to this project are documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). 4 | 5 | ## [Unreleased] 6 | 7 | Breaking changes: 8 | 9 | New features: 10 | - [Decoders for `Char`](https://github.com/purescript-contrib/purescript-argonaut-codecs/pull/114) 11 | 12 | Bugfixes: 13 | 14 | Other improvements: 15 | - Decoding and encoding of the `Const` functor. (#118 by @bakhtiyarneyman) 16 | 17 | ## [v9.0.0](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v9.1.0) - 2022-06-23 18 | 19 | New features: 20 | - Added `fromJsonString` and `toJsonString` (#109 by @sigma-andex) 21 | 22 | ## [v9.0.0](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v9.0.0) - 2022-04-27 23 | 24 | Breaking changes: 25 | - Update project and deps to PureScript v0.15.0 (#106 by @JordanMartinez) 26 | 27 | Other improvements: 28 | - Added `purs-tidy` formatter (#104 by @thomashoneyman) 29 | 30 | ## [v8.1.0](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v8.1.0) - 2021-04-09 31 | 32 | New features: 33 | - Added support for decoding missing record fields to `Nothing` (#93 by @jvliwanag) 34 | 35 | ## [v8.0.0](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v8.0.0) - 2021-02-26 36 | 37 | Breaking changes: 38 | - Added support for PureScript 0.14 and dropped support for all previous versions (#90, #96) 39 | 40 | New features: 41 | - Added decoders for `NonEmptyString` and added a new `decodeNonempty` function (#94) 42 | - Added encoder for `NonEmptyString` (d0liver, #98) 43 | 44 | Bugfixes: 45 | 46 | Other improvements: 47 | - Fixed a typo in the documentation in which `String` was still used as the error type instead of `JsonDecodeError` (#88) 48 | - Added minor clarifications to multi-arg example (#84) 49 | - Changed default branch to `main` from `master` 50 | - Updated to comply with Contributors library guidelines by adding new issue and pull request templates, updating documentation, and migrating to Spago for local development and CI (#86, #89) 51 | 52 | ## [v7.0.0](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v7.0.0) - 2020-06-19 53 | 54 | This release introduces a few major changes: 55 | 56 | **Introducing typed errors** 57 | 58 | This release introduces a shift in the way this library handles errors. Previously, errors were reported as `String` values when decoding. Now, errors are reported as `JsonDecodeError` values, which provide much richer information about what errors have occurred. This brings this library into line with `purescript-codec-argonaut`, which also uses typed errors. 59 | 60 | There are new functions to help work with this error type: 61 | 62 | - `printJsonDecodeError :: JsonDecodeError -> String` can be used to recover a string error from a typed error 63 | - `parseJson :: String -> Either JsonDecodeError Json` can be used instead of `Data.Argonaut.Parser.jsonParser` if you need to parse a `Json` value from a JSON string. It uses `jsonParser` under the hood, but provides a typed error instead of a string error. 64 | 65 | Implemented in #73 and relevant documentation updated in #80. 66 | 67 | **Add encoding and decoding functions without type classes** 68 | 69 | Sometimes it is useful to be able to use the encoders and decoders defined in this library without needing the type classes. If you want to use the functions directly without a type class, they can now be found in the `Data.Argonaut.Decode.Decoders` and `Data.Argonaut.Encode.Encoders` modules. 70 | 71 | Implemented in #74. 72 | 73 | **Removed deprecated functions and operators** 74 | 75 | A number of functions and operators were deprecated in the last release. Their removal doesn't change the functionality of this library -- as noted in the prior release, all deprecated operators have functionally-equivalent alternatives. For example: 76 | 77 | - `.?` -> `.:` 78 | - `.??` -> `.:?` 79 | - `.?!` -> `.:!` 80 | 81 | Implemented in #82. 82 | 83 | **Migrate the library to use Spago** 84 | 85 | This is a purely internal change, but the `purescript-argonaut-codecs` library now uses Spago internally to manage dependencies and the overall build. Over time the purescript-contrib organization will shift to use Spago instead of Pulp + Bower. 86 | 87 | Implemented in #81. 88 | 89 | ## [v6.1.0](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v6.1.0) - 2020-05-08 90 | 91 | This release includes two small improvements to the library: 92 | 93 | - Added new instances for `NonEmptyArray` and `NonEmptyList` (#61) and `Identity` (#54) 94 | - Elaborated errors produced with the generic instance for records (#72) 95 | 96 | As well as a new tutorial for the library (#62). 97 | 98 | ## [v6.0.2](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v6.0.2) - 2019-05-06 99 | 100 | - Fixed associativity of a type annotation in advance of new `purs` version 101 | 102 | ## [v6.0.1](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v6.0.1) - 2019-03-24 103 | 104 | - Fixed a typo in documentation (@JamieBallingall) 105 | 106 | ## [v6.0.0](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v6.0.0) - 2019-03-05 107 | 108 | - Updated dependencies 109 | 110 | ## [v5.1.3](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v5.1.3) - 2019-03-01 111 | 112 | - Updated `getFieldOptional'` to use the `elaborateFailure` helper to produce more descriptive error messages (@LucianU) 113 | 114 | ## [v5.1.2](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v5.1.2) - 2019-01-28 115 | 116 | - Fixed a typo in the `getFieldOptional` docs (@Jwhiles) 117 | 118 | ## [v5.1.1](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v5.1.1) - 2019-01-04 119 | 120 | - Bumped minor dependencies (@thomashoneyman) 121 | - Added instances for `Set` (@bradediger) 122 | 123 | ## [v5.1.0](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v5.1.0) - 2018-11-24 124 | 125 | - Updated combinators and operators to better reflect the usage pattern of Aeson, providing deprecation warnings for the old combinators (@davezuch) 126 | 127 | ## [v5.0.0](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v5.0.0) - 2018-11-09 128 | 129 | - Added support for encoding and decoding record types (@elliotdavies) 130 | 131 | ## [v4.0.2](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v4.0.2) - 2018-06-27 132 | 133 | - Added better error messages (@crcornwell): 134 | - Tells you which index did not exist if you fail to access an array 135 | - Tells you which key did not exist if you fail to access an object 136 | 137 | ## [v4.0.1](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v4.0.1) - 2018-06-22 138 | 139 | - Added metadata including contributor guidelines 140 | - Pushed latest release to Pursuit 141 | 142 | ## [v4.0.0](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v4.0.0) - 2018-06-04 143 | 144 | - Updated for PureScript 0.12 145 | 146 | ## [v3.3.0](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v3.3.0) - 2018-03-15 147 | 148 | - Added `assocOptional` and `encodeOptional` functions and operators (@foresttoney, @kanterov) 149 | 150 | ## [v3.2.0](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v3.2.0) - 2017-07-10 151 | 152 | - Added `(.?=)` operator for specifying a default value for an optional field (@cdepillabout) 153 | 154 | ## [v3.1.0](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v3.1.0) - 2017-05-24 155 | 156 | - `getFieldOptional` and corresponding `(.??)` operator are now exported from `Data.Argonaut.Decode` (@cdepillabout) 157 | 158 | ## [v3.0.1](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v3.0.1) - 2017-04-24 159 | 160 | - Reverted the change to the `Maybe` codec as it was not functioning correctly. The original behaviour has been restored. 161 | 162 | ## [v3.0.0](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v3.0.0) - 2017-04-08 163 | 164 | - Updated for PureScript 0.11 165 | - Encoding and decoding of `Maybe` has been updated to be able to accurately represent nested `Maybe`s. The `DecodeJson` instance is compatible with the old format, but `EncodeJson` produces a different structure now, so this may be a breaking change depending on your use case. 166 | 167 | ## [v2.1.0](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v2.1.0) - 2017-03-07 168 | 169 | - Added codecs for `Void` (@natefaubion) 170 | 171 | ## [v2.0.0](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v2.0.0) - 2016-10-22 172 | 173 | - Updated dependencies 174 | 175 | ## [v1.1.0](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v1.1.0) - 2016-08-05 176 | 177 | - Added `(.??)` combinator for attempting to read fields that are optional (@passy) 178 | 179 | ## [v1.0.0](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v1.0.0) - 2016-06-11 180 | 181 | Updates for the 1.0 core libraries. 182 | 183 | ## [v0.6.1](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v0.6.1) - 2016-01-15 184 | 185 | - Fixed import warning 186 | 187 | ## [v0.6.0](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v0.6.0) - 2016-01-15 188 | 189 | - The encoding of `Either` has been modified to be more explicit, allowing `Either` with the same type on either side to be decoded (@hdgarrood) 190 | 191 | ## [v0.5.2](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v0.5.2) - 2016-01-13 192 | 193 | - Improved generic decoding errors (@hdgarrood) 194 | 195 | ## [v0.5.1](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v0.5.1) - 2015-12-22 196 | 197 | - The `DecodeJson` instance for `Maybe` now treats `null` as `Nothing` to match the `EncodeJson` instance 198 | 199 | ## [v0.5.0](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v0.5.0) - 2015-11-20 200 | 201 | - Updated for PureScript 0.7.6 and the updated generics (@zudov). **Note**: this release _requires_ PureScript 0.7.6 or newer. 202 | 203 | ## [v0.4.1](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v0.4.1) - 2015-11-04 204 | 205 | - Fixed various warnings 206 | 207 | ## [v0.4.0](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v0.4.0) - 2015-11-04 208 | 209 | - Updated dependencies 210 | 211 | ## [v0.3.0](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v0.3.0) - 2015-08-25 212 | 213 | - Added generic deriving (#3) 214 | 215 | ## [v0.2.0](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v0.2.0) - 2015-08-19 216 | 217 | - Updated dependencies for PureScript 0.7.3 (@zudov) 218 | 219 | ## [v0.1.0](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases/tag/v0.1.0) - 2015-07-13 220 | 221 | - Initial release 222 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing to Argonaut Codecs 2 | 3 | Thanks for your interest in contributing to `argonaut-codecs`! We welcome new contributions regardless of your level of experience or familiarity with PureScript. 4 | 5 | Every library in the Contributors organization shares a simple handbook that helps new contributors get started. With that in mind, please [read the short contributing guide on purescript-contrib/governance](https://github.com/purescript-contrib/governance/blob/main/contributing.md) before contributing to this library. 6 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2020 PureScript Contrib 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | 23 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Argonaut Codecs 2 | 3 | [![CI](https://github.com/purescript-contrib/purescript-argonaut-codecs/workflows/CI/badge.svg?branch=main)](https://github.com/purescript-contrib/purescript-argonaut-codecs/actions?query=workflow%3ACI+branch%3Amain) 4 | [![Release](http://img.shields.io/github/release/purescript-contrib/purescript-argonaut-codecs.svg)](https://github.com/purescript-contrib/purescript-argonaut-codecs/releases) 5 | [![Pursuit](http://pursuit.purescript.org/packages/purescript-argonaut-codecs/badge)](http://pursuit.purescript.org/packages/purescript-argonaut-codecs) 6 | 7 | [Argonaut](https://github.com/purescript-contrib/purescript-argonaut) is a collection of libraries for working with JSON in PureScript. `argonaut-codecs` provides codecs based on the `EncodeJson` and `DecodeJson` type classes, along with instances for common data types and combinators for encoding and decoding `Json` values. 8 | 9 | You may also be interested in these other libraries from the Argonaut ecosystem: 10 | 11 | - [purescript-argonaut-core](https://github.com/purescript-contrib/purescript-argonaut-core) defines the `Json` type, along with basic parsing, printing, and folding functions 12 | - [purescript-argonaut-traversals](https://github.com/purescript-contrib/purescript-argonaut-traversals) defines prisms, traversals, and zippers for the `Json` type. 13 | - [purescript-argonaut-generic](https://github.com/purescript-contrib/purescript-argonaut-generic) supports generic encoding and decoding for any type with a `Generic` instance 14 | - [purescript-codec-argonaut](https://github.com/garyb/purescript-codec-argonaut) supports an alternative approach for codecs, which are based on profunctors instead of type classes 15 | 16 | The quick start will get you up and running with the basics of `argonaut-codecs`. For a deeper dive, please see [the full documentation for this library](./docs), which includes an in-depth tutorial. 17 | 18 | ## Installation 19 | 20 | Install `argonaut-codecs` with [Spago](https://github.com/purescript/spago): 21 | 22 | ```sh 23 | spago install argonaut-codecs 24 | ``` 25 | 26 | or install it as part of the [Argonaut](https://github.com/purescript-contrib/purescript-argonaut) bundle: 27 | 28 | ```sh 29 | spago install argonaut 30 | ``` 31 | 32 | ## Quick start 33 | 34 | Use `encodeJson` to encode PureScript data types as `Json` and `decodeJson` to decode `Json` into PureScript types, with helpful error messages if decoding fails. 35 | 36 | ```purs 37 | type User = { name :: String, age :: Maybe Int } 38 | 39 | -- We get encoding and decoding for free because of the `EncodeJson` instances 40 | -- for records, strings, integers, and `Maybe`, along with many other common 41 | -- PureScript types. 42 | 43 | userToJson :: User -> Json 44 | userToJson = encodeJson 45 | 46 | userFromJson :: Json -> Either JsonDecodeError User 47 | userFromJson = decodeJson 48 | ``` 49 | 50 | In a REPL we can see these functions in action: 51 | 52 | ```text 53 | > type User = { name :: String, age :: Maybe Int } 54 | > user = { name: "Tom", age: Just 25 } 55 | > stringify (encodeJson user) 56 | "{\"name\":\"Tom\",\"age\":25}" 57 | 58 | > (decodeJson =<< parseJson """{ "name": "Tom", "age": 25 }""") :: Either JsonDecodeError User 59 | Right { name: "Tom", age: Just 25 } 60 | 61 | > res = (decodeJson =<< parseJson """{ "name": "Tom" }""") :: Either JsonDecodeError User 62 | > res 63 | Left (AtKey "age" MissingValue) 64 | 65 | # You can print errors 66 | > lmap printJsonDecodeError res 67 | Left "An error occurred while decoding a JSON value:\n At object key 'age':\n No value was found." 68 | ``` 69 | 70 | ## Documentation 71 | 72 | `argonaut-codecs` documentation is stored in a few places: 73 | 74 | 1. Module documentation is [published on Pursuit](https://pursuit.purescript.org/packages/purescript-argonaut-codecs). 75 | 2. Written documentation is kept in [the docs directory](./docs). 76 | 3. Usage examples can be found in [the test suite](./test). 77 | 78 | If you get stuck, there are several ways to get help: 79 | 80 | - [Open an issue](https://github.com/purescript-contrib/purescript-argonaut-codecs/issues) if you have encountered a bug or problem. 81 | - Ask general questions on the [PureScript Discourse](https://discourse.purescript.org) forum or the [PureScript Discord](https://purescript.org/chat) chat. 82 | 83 | ## Contributing 84 | 85 | You can contribute to `argonaut-codecs` in several ways: 86 | 87 | 1. If you encounter a problem or have a question, please [open an issue](https://github.com/purescript-contrib/purescript-argonaut-codecs/issues). We'll do our best to work with you to resolve or answer it. 88 | 89 | 2. If you would like to contribute code, tests, or documentation, please [read the contributor guide](./CONTRIBUTING.md). It's a short, helpful introduction to contributing to this library, including development instructions. 90 | 91 | 3. If you have written a library, tutorial, guide, or other resource based on this package, please share it on the [PureScript Discourse](https://discourse.purescript.org)! Writing libraries and learning resources are a great way to help this library succeed. 92 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-argonaut-codecs", 3 | "license": [ 4 | "MIT" 5 | ], 6 | "repository": { 7 | "type": "git", 8 | "url": "https://github.com/purescript-contrib/purescript-argonaut-codecs.git" 9 | }, 10 | "ignore": [ 11 | "**/.*", 12 | "node_modules", 13 | "bower_components", 14 | "output" 15 | ], 16 | "dependencies": { 17 | "purescript-argonaut-core": "^7.0.0", 18 | "purescript-arrays": "^7.0.0", 19 | "purescript-bifunctors": "^6.0.0", 20 | "purescript-const": "^6.0.0", 21 | "purescript-effect": "^4.0.0", 22 | "purescript-either": "^6.0.0", 23 | "purescript-foldable-traversable": "^6.0.0", 24 | "purescript-foreign-object": "^4.0.0", 25 | "purescript-identity": "^6.0.0", 26 | "purescript-integers": "^6.0.0", 27 | "purescript-lists": "^7.0.0", 28 | "purescript-maybe": "^6.0.0", 29 | "purescript-nonempty": "^7.0.0", 30 | "purescript-ordered-collections": "^3.0.0", 31 | "purescript-prelude": "^6.0.0", 32 | "purescript-record": "^4.0.0", 33 | "purescript-strings": "^6.0.0", 34 | "purescript-tuples": "^7.0.0" 35 | }, 36 | "devDependencies": { 37 | "purescript-assert": "^6.0.0", 38 | "purescript-console": "^6.0.0", 39 | "purescript-exceptions": "^6.0.0", 40 | "purescript-gen": "^4.0.0", 41 | "purescript-quickcheck": "^8.0.1", 42 | "purescript-transformers": "^6.0.0" 43 | } 44 | } 45 | -------------------------------------------------------------------------------- /docs/README.md: -------------------------------------------------------------------------------- 1 | # Argonaut Codecs Documentation 2 | 3 | This library provides provides type classes and combinators for convenient encoding and decoding of `Json` for data types in your application, and includes instances for encoding and decoding most common PureScript types. 4 | 5 | As a brief aside: this library works with `Json` values, not raw JSON strings. 6 | 7 | - If you need to parse `Json` from a JSON string so that you can use `decodeJson`, then you should use the `parseJson` function from `Data.Argonaut.Decode.Parser` (re-exported by `Data.Argonaut.Decode`). 8 | - If you need to print `Json` as a valid JSON string (after using `encodeJson`, for example), then you should use the `stringify` function from `argonaut-core`. 9 | 10 | ## Setup 11 | 12 | You can follow along with this tutorial in a repl. You should install these dependencies: 13 | 14 | ```sh 15 | spago install argonaut-codecs validation 16 | ``` 17 | 18 | > You can also install `argonaut` and only import `Data.Argonaut` instead of all the individual `Data.Argonaut.*` modules, if you prefer a shorter import list. 19 | 20 | Next, import the modules used in this tutorial: 21 | 22 | ```purs 23 | import Prelude 24 | 25 | import Control.Alternative 26 | import Data.Argonaut.Core 27 | import Data.Argonaut.Encode 28 | import Data.Argonaut.Decode 29 | import Data.Bifunctor 30 | import Data.Maybe 31 | import Data.Newtype 32 | import Data.Either 33 | import Data.Validation.Semigroup 34 | import Foreign.Object 35 | ``` 36 | 37 | > Tip: you can place this snippet in a `.purs-repl` file so the imports are loaded automatically when you run `spago repl` 38 | 39 | ## Automatic Encoding & Decoding 40 | 41 | The `EncodeJson` and `DecodeJson` type classes let you rely on instances for common data types to automatically encode and decode `Json`. Let's explore automatic encoding and decoding using a type typical of PureScript applications as our example: 42 | 43 | ```purs 44 | type User = 45 | { name :: String 46 | , age :: Maybe Int 47 | , team :: Maybe String 48 | } 49 | ``` 50 | 51 | > Tip: If you're following along in the repl, you can either define this type on one line or use `:paste` to input multiple lines followed by Ctrl+D to end the paste. 52 | 53 | ### Automatic encoding with `EncodeJson` and `encodeJson` 54 | 55 | We can automatically encode `Json` using the `EncodeJson` type class ([pursuit](https://pursuit.purescript.org/packages/purescript-argonaut-codecs/docs/Data.Argonaut.Encode#t:EncodeJson)). 56 | 57 | Our `User` type is made up of several other types: `Record`, `Maybe`, `Int`, and `String`. Each of these types have instances for `EncodeJson`, which means that we can use the `encodeJson` function with them. Integers and strings will be encoded directly to `Json`, while container types like `Record` and `Maybe` will require on all of the types they contain to also have `EncodeJson` instances. 58 | 59 | ```purs 60 | encodeJson :: EncodeJson a => a -> Json 61 | ``` 62 | 63 | > Tip: There is no `Show` instance for `Json`. To print a `Json` value as a valid JSON string, use `stringify` -- it's the same as the [JavaScript `stringify` method](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/JSON/stringify). 64 | 65 | ```text 66 | > user = { name: "Tom", age: Just 25, team: Just "Red Team" } :: User 67 | > stringify (encodeJson user) 68 | "{\"name\":\"Tom\",\"age\":25,\"team\":\"Red Team\"}" 69 | ``` 70 | 71 | ### Automatic decoding with `DecodeJson` and `decodeJson` 72 | 73 | We can automatically decode `Json` using the `DecodeJson` type class ([pursuit](https://pursuit.purescript.org/packages/purescript-argonaut-codecs/docs/Data.Argonaut.Decode#t:DecodeJson)). 74 | 75 | Every type within `User` has an instance for `DecodeJson`, which means we can use the `decodeJson` function to try to decode a `Json` value into our type. Once again, integer and string values will be decoded directly from the `Json`, but containing types like `Record` and `Maybe` will also require instances for the types they contain. 76 | 77 | ```purs 78 | decodeJson :: DecodeJson a => Json -> Either JsonDecodeError a 79 | ``` 80 | 81 | > Tip: To parse a JSON string as a `Json` value, you can use the `parseJson` function (which can fail). If you are sure you have valid JSON, then consider writing it in an FFI file and foreign importing it as `Json` as described in the [`argonaut-core` documentation](https://github.com/purescript-contrib/purescript-argonaut-core#introducing-json-values). 82 | 83 | ```text 84 | > userJsonString = """{ "name": "Tom", "age": 25, "team": null }""" 85 | > decodedUser = decodeJson =<< parseJson userJsonString 86 | 87 | # there is no `Show` instance for `Json`, so we'll stringify the decoded result 88 | # so it can be displayed in the repl 89 | > map stringify decodedUser 90 | Right "{\"name\":\"Tom\",\"age\":25,\"team\":null}" 91 | ``` 92 | 93 | Decoding can fail if the `Json` doesn't match the shape expected by a `DecodeJson` instance; in that case, an error is returned instead of the decoded value. 94 | 95 | ```text 96 | > badUserJsonString = """{ "name": "Tom", "age": null }""" 97 | > decoded = (decodeJson =<< parseJson badUserJsonString) :: Either JsonDecodeError User 98 | > decoded 99 | Left (AtKey "team" MissingValue) 100 | ``` 101 | 102 | This library uses an error type to represent possible ways that decoding JSON can fail, and it then uses this error type to create helpful error messages. For example, our input JSON was a valid object, but it was missing the "team" key that we need in order to decode to a valid `User`. We can print our error to get a human-friendly string message: 103 | 104 | ```text 105 | > lmap printDecodeJsonError decoded 106 | > printDecodeJsonError (AtKey "team" MissingValue) 107 | Left "An error occurred while decoding a JSON value:\n At object key 'team':\n No value was found." 108 | ``` 109 | 110 | ## Writing New Instances 111 | 112 | While instances of `EncodeJson` and `DecodeJson` exist for most common data types in the PureScript ecosystem, you will sometimes need to write your own. Common reasons to write your own instances include: 113 | 114 | 1. You have defined a new data type 115 | 2. You require `encodeJson` or `decodeJson` to behave differently, for a given type, than its existing `EncodeJson` or `DecodeJson` instance 116 | 3. You are using a data type which already exists, but does not have an `EncodeJson` or `DecodeJson` instance (typically because there are many reasonable ways to represent the data in JSON types, as is the case with dates). 117 | 118 | It is also common to have a 'default' way to decode or encode a particular data type, but to write alternative decoding and encoding functions that can be used instead of the one supported by the type class. 119 | 120 | Let's explore the combinators provided by `argonaut-codecs` for encoding and decoding `Json` by treating our `User` type as a new data type instead of just a synonym for a record, and turning the `team` field into a sum type instead of just a `String`. 121 | 122 | > Remember that you can write multi-line definitions using by typing :paste in the repl, and then using Ctrl+D to exit when you're done. 123 | 124 | ```purs 125 | newtype AppUser = AppUser 126 | { name :: String 127 | , age :: Maybe Int 128 | , team :: Team 129 | } 130 | 131 | data Team 132 | = RedTeam 133 | | BlueTeam 134 | ``` 135 | 136 | ### Encoding JSON 137 | 138 | To encode JSON, you must decide on a way to represent your data using only primitive JSON types (strings, numbers, booleans, arrays, objects, or null). Since PureScript's string, number, boolean, and array types already have `EncodeJson` instances, your responsibility is to find a way to transform your data types to those more primitive types so they can be encoded. 139 | 140 | Let's start with our `Team` type, which doesn't have an `EncodeJson` instance yet. It can be represented in JSON by simple strings, so let's write a function to convert `Team` to a `String`: 141 | 142 | ```purs 143 | teamToString :: Team -> String 144 | teamToString = case _ of 145 | RedTeam -> "Red Team" 146 | BlueTeam -> "Blue Team" 147 | ``` 148 | 149 | We can now write an `EncodeJson` instance for our type. As a brief reminder, this is the type signature required by `encodeJson`: 150 | 151 | ```purs 152 | encodeJson :: EncodeJson a => a -> Json 153 | ``` 154 | 155 | `String` already has an instance of `EncodeJson`, so all we need to do is convert our type to a string and then use `encodeJson` to encode the resulting string. 156 | 157 | ```purs 158 | instance encodeJsonTeam :: EncodeJson Team where 159 | encodeJson team = encodeJson (teamToString team) 160 | ``` 161 | 162 | If your type can be converted easily to a `String`, `Number`, or `Boolean`, then its `EncodeJson` instance will most likely look like the one we've written for `Team`. 163 | 164 | Most reasonably complex data types are best represented as objects, however. We can use combinators from `Data.Argonaut.Encode.Combinators` to conveniently encode `Json` objects manually. You'll provide `String` keys and values which can be encoded to `Json`. 165 | 166 | - Use `:=` (`assoc`) to encode a key/value pair where the key must exist; encoding the key `"team"` and value `Nothing` will insert the key `"team"` with the value `null`. 167 | - Use `~>` (`extend`) to provide more key/value pairs after using `:=`. 168 | - Use `:=?` (`assocOptional`) to encode a key/value pair where the key _may_ exist; encoding the key `"age"` and value `Nothing` will not insert the `"age"` key. 169 | - Use `~>?` (`extendOptional`) to provide more key/value pairs after using `:=?`. 170 | 171 | Let's use these combinators to encode a `Json` object from our `AppUser` record. 172 | 173 | ```purs 174 | instance encodeJsonAppUser :: EncodeJson AppUser where 175 | encodeJson (AppUser { name, age, team }) = 176 | "name" := name -- inserts "name": "Tom" 177 | ~> "age" :=? age -- inserts "age": "25" (if Nothing, does not insert anything) 178 | ~>? "team" := team -- inserts "team": "Red Team" 179 | ~> jsonEmptyObject 180 | ``` 181 | 182 | To recap: manually encoding your data type involves a few steps: 183 | 184 | 1. Ensure that all types you are encoding have an `EncodeJson` instance or can be converted to another type which does. 185 | 2. Use `:=` or `:=?` to create a key/value pair in a JSON object 186 | 3. Use `~>` or `~>?` to chain together multiple key/value pairs. 187 | 188 | Ultimately, this will produce `Json` which can be serialized to a JSON string or manipulated. 189 | 190 | ### Decoding JSON 191 | 192 | Decoding PureScript types from `Json` is similar to encoding them. You'll once again need a mapping from your data type to its representation in primitive JSON types. Booleans, strings, numbers, and arrays are covered by existing `DecodeJson` instances, so if you can convert from any of those types to your PureScript type then you can use that conversion to write a `DecodeJson` instance for your type. 193 | 194 | Let's begin once again with our `Team` type, which can be represented as a string in JSON and does not have a `DecodeJson` instance yet. We'll start by writing a function which tries to produce a `Team` from a `String`: 195 | 196 | ```purs 197 | teamFromString :: String -> Maybe Team 198 | teamFromString = case _ of 199 | "Red Team" -> Just RedTeam 200 | "Blue Team" -> Just BlueTeam 201 | _ -> Nothing 202 | ``` 203 | 204 | We can use this function to write a `DecodeJson` instance for our type. As a quick reminder, this is the type signature required by `decodeJson`: 205 | 206 | ```purs 207 | decodeJson :: DecodeJson a => Json -> Either JsonDecodeError a 208 | ``` 209 | 210 | Let's write the instance using `note` from `purescript-either`: 211 | 212 | ```purs 213 | instance decodeJsonTeam :: DecodeJson Team where 214 | decodeJson json = do 215 | string <- decodeJson json 216 | note (TypeMismatch "Team") (teamFromString string) 217 | ``` 218 | 219 | If your type can be represented easily with a `String`, `Number`, `Boolean`, or array of one of these types, then its `DecodeJson` will most likely look similar to this one. 220 | 221 | However, quite often your data type will require representation as an object. This library provides combinators in `Data.Argonaut.Decode.Combinators` which are useful for decoding objects into PureScript types by looking up keys in the object and decoding them according to their `DecodeJson` instances. 222 | 223 | - Use `.:` (`getField`) to decode a field where the key must exist; if the field is missing, this will fail with a decoding error. 224 | - Use `.:?` (`getFieldOptional'`) to decode a field where the key may exist; if the field is missing or its value is `null` then this will return `Nothing`, and otherwise it will attempt to decode the value at the given key. 225 | - Use `.!=` (`defaultField`) in conjunction with `.:?` to provide a default value for a field which may not exist. If decoding fails, you'll still get an error; if decoding succeeds with a value of type `Maybe a`, then this default value will handle the `Nothing` case. 226 | 227 | Let's use these combinators to decode a `Json` object into our `AppUser` record. 228 | 229 | The `decodeJson` function returns an `Either JsonDecodeErorr a` value; `Either` is a monad, which means we can use convenient `do` syntax to write our decoder. If a step in decoding succeeds, then its result is passed to the next step. If any step in decoding fails, the entire computation will abort with the error it encountered. 230 | 231 | ```purs 232 | instance decodeJsonAppUser :: DecodeJson AppUser where 233 | decodeJson json = do 234 | obj <- decodeJson json -- decode `Json` to `Object Json` 235 | name <- obj .: "name" -- decode the "name" key to a `String` 236 | age <- obj .:? "age" -- decode the "age" key to a `Maybe Int` 237 | team <- obj .:? "team" .!= RedTeam -- decode "team" to `Team`, defaulting to `RedTeam` 238 | -- if the field is missing or `null` 239 | pure $ AppUser { name, age, team } 240 | ``` 241 | 242 | To recap: manually decoding your data type involves a few steps: 243 | 244 | 1. Ensure that all types you are decoding have a `DecodeJson` instance 245 | 2. Use `.:` to decode object fields where the key must exist 246 | 3. Use `.:?` to decode object fields where the key may exist or its value may be null 247 | 4. Use `.!=` to provide a default value for fields which may exist in the `Json`, but must exist in the type you're decoding to (it's like `fromMaybe` for your decoder, unwrapping the decoded value). 248 | 5. It's common to use the `Either` monad for convenience when writing decoders. Any failed decoding step will abort the entire computation with that error. See [Solving Common Problems](#solving-common-problems) for alternative approaches to decoding. 249 | 250 | ## Deriving Instances 251 | 252 | There are two ways to derive instances of `EncodeJson` and `DecodeJson` for new types. 253 | 254 | ### Newtype Deriving 255 | 256 | We intentionally introduced a newtype around a record, `AppUser`, so that we could hand-write type class instances for it. What if we'd needed the newtype for another reason, and we planned on using the same encoding and decoding as the underlying type's instances provide? 257 | 258 | In that case, we can use newtype deriving to get `EncodeJson` and `DecodeJson` for our newtype for free: 259 | 260 | ```purs 261 | newtype AppUser = AppUser { name :: String, age :: Maybe Int, team :: Team } 262 | 263 | derive instance newtypeAppUser :: Newtype AppUser _ 264 | 265 | derive newtype instance encodeJsonAppUser :: EncodeJson AppUser 266 | derive newtype instance decodeJsonAppUser :: DecodeJson AppUser 267 | ``` 268 | 269 | ### Generics 270 | 271 | If your data type has an instance of `Generic`, then you can use [purescript-argonaut-generic](https://github.com/purescript-contrib/purescript-argonaut-generic) to leverage `genericEncodeJson` and `genericDecodeJson` to write your instances: 272 | 273 | ```purs 274 | import Data.Generic.Rep (class Generic) 275 | import Data.Argonaut.Encode.Generic.Rep (genericEncodeJson) 276 | import Data.Argonaut.Decode.Generic.Rep (genericDecodeJson) 277 | 278 | data Team = RedTeam | BlueTeam 279 | 280 | derive instance genericTeam :: Generic Team _ 281 | 282 | instance encodeJsonTeam :: EncodeJson Team where 283 | encodeJson = genericEncodeJson 284 | 285 | instance decodeJsonTeam :: DecodeJson Team where 286 | decodeJson = genericDecodeJson 287 | ``` 288 | 289 | Here is another example of how to derive a generic instance of a type with a type variable. This type also happens to be recursive: 290 | 291 | ```purs 292 | data Chain a 293 | = End a 294 | | Link a (Chain a) 295 | 296 | derive instance genericChain :: Generic (Chain a) _ 297 | 298 | instance encodeJsonChain :: EncodeJson a => EncodeJson (Chain a) where 299 | encodeJson chain = genericEncodeJson chain 300 | 301 | instance decodeJsonChain :: DecodeJson a => DecodeJson (Chain a) where 302 | decodeJson chain = genericDecodeJson chain 303 | ``` 304 | 305 | Note the addition of instance dependencies for the type variable `a`. Also note that these instances for a recursive type cannot be written in point-free style, as that would likely cause a stack overflow during execution. Instead, we use the variables `chain` to apply eta-expansion. 306 | 307 | More information about how to derive generic instances can be found in this [24-days-of-purescript post](https://github.com/paf31/24-days-of-purescript-2016/blob/master/11.markdown#deriving-generic-instances). 308 | 309 | ## Solving Common Problems 310 | 311 | ### Handling Multiple JSON Representations 312 | 313 | Sometimes a data type in your application can be represented in multiple formats. For example, consider a `User` type like this: 314 | 315 | ```purs 316 | newtype User = User 317 | { uuid :: String 318 | , name :: String 319 | } 320 | ``` 321 | 322 | In previous versions of your API the `uuid` field has been named `uid` and `id`. Unfortunately, you receive data from all three versions, so you need to accommodate each. You only want one canonical type in your application, though: the `User` type above. 323 | 324 | There are several ways to handle the case in which a data type has multiple JSON representations. 325 | 326 | #### 1. Use `Alternative` to provide fallback decoders 327 | 328 | The first option is to use the `Alternative` type class and its `<|>` operator to provide multiple ways to decode a particular field in an object. For example: 329 | 330 | ```purs 331 | instance decodeJsonUser :: DecodeJson User where 332 | decodeJson json = do 333 | obj <- decodeJson json 334 | name <- obj .: "name" 335 | uuid <- obj .: "uuid" <|> obj .: "uid" <|> obj .: "id" 336 | pure $ User { name, uuid } 337 | ``` 338 | 339 | You may sometimes need to do additional processing so that `uuid` always ends up being decoded to the correct type. For example, if in a previous API version the `id` field was actually an object with a `value` field containing the id, then you could provide a two-step decoder for that case. 340 | 341 | ```purs 342 | instance decodeJsonUser :: DecodeJson User where 343 | decodeJson json = do 344 | ... 345 | uuid <- obj .: "uuid" <|> obj .: "uid" <|> ((_ .: "value") =<< obj .: "id") 346 | ``` 347 | 348 | #### 2. Write multiple `encodeJson` or `decodeJson` functions 349 | 350 | Another option is to have a default representation for the type implemented as the type class instance, but alternative `decodeJson` and `encodeJson` functions which can be used directly. For example, consider the case in which our `User` data can be sent to multiple sources. One source requires the data to be formatted as an object, and another requires it to be formatted as a two-element array. 351 | 352 | In this case, our type class instance can use the default object encoding, and we can supply a separate `encodeJsonAsArray` function for use when required. 353 | 354 | ```purs 355 | -- our default object encoding 356 | derive newtype instance encodeJsonUser :: EncodeJson User 357 | 358 | encodeUserAsArray :: User -> Json 359 | encodeUserAsArray user = encodeJson [ user.uuid, user.name ] 360 | ``` 361 | 362 | ### Decoding With More Arguments than `Json` 363 | 364 | You may occasionally be unable to write `EncodeJson` or `DecodeJson` instances for a data type because it requires more information than just `Json` as its argument. For instance, consider this pair of types: 365 | 366 | ```purs 367 | data Author 368 | = Following String -- you are subscribed to this author 369 | | NotFollowing String -- you aren't subscribed to this author 370 | | You -- you are the author 371 | 372 | type BlogPost = 373 | { title :: String 374 | , author :: Author 375 | } 376 | ``` 377 | 378 | Our API sends us the author of the blog post as a string and whether we follow them as a boolean. This admits more cases than are actually possible -- you can't follow yourself, for example -- so we are more precise and model an `Author` as a sum type. 379 | 380 | When our application is running we know who the currently-authenticated user is, and we can use that information to determine the `Author` type. That means we can't decode an `Author` from `Json` alone -- we need more information. 381 | 382 | In these cases, unfortunately, you can't write an instance of `DecodeJson` for the data type. You can, however, write `decodeJsonAuthor` and use it without the type class. For instance: 383 | 384 | ```purs 385 | decodeJsonAuthor :: Maybe Username -> Json -> Either JsonDecodeError Author 386 | decodeJsonAuthor maybeUsername json = do 387 | obj <- decodeJson json 388 | author <- obj .: "author" 389 | following <- obj .: "following" 390 | pure $ case maybeUsername of 391 | -- user is logged in and is the author 392 | Just (Username username) | author == username -> You 393 | -- user is not the author, or no one is logged in, so use the `following` flag 394 | _ -> author # if following then Following else NotFollowing 395 | 396 | decodeJsonBlogPost :: Maybe Username -> Json -> Either JsonDecodeError BlogPost 397 | decodeJsonBlogPost username json = do 398 | obj <- decodeJson json 399 | title <- obj .: "title" 400 | author <- decodeJsonAuthor username =<< obj .: "author" 401 | pure { title, author } 402 | ``` 403 | 404 | ### Writing Instances For Types You Don't Own 405 | 406 | While not an issue specific to `argonaut-codecs`, you may sometimes wish to write an `EncodeJson` or a `DecodeJson` instance for a data type you did not define -- for instance, the `PreciseDateTime` type from `purescript-precise-datetime`. This type has no instances because there are many ways you might wish to represent it in JSON. 407 | 408 | If you want to use an application-specific encoding for this type then you will need to define a newtype wrapper for it and define instances for that new type instead. You cannot simply write an instance for the original `PreciseDateTime` type as that would be creating an orphan instance. 409 | 410 | ```purs 411 | module App.Data.PreciseDateTime where 412 | 413 | import Data.PreciseDateTime as PDT 414 | import Data.RFC3339String (RFC3339String(..)) 415 | 416 | newtype PreciseDateTime = PreciseDateTime PDT.PreciseDateTime 417 | 418 | instance decodeJsonPreciseDateTime :: DecodeJson PreciseDateTime where 419 | decodeJson json = fromString =<< decodeJson json 420 | where 421 | fromString :: String -> Either JsonDecodeError PreciseDateTime 422 | fromString = 423 | map PreciseDateTime 424 | <<< note (TypeMismatch "RFC3339String") 425 | <<< PDT.fromRFC3339String 426 | <<< RFC3339String 427 | ``` 428 | 429 | You can now use the wrapped `PreciseDateTime` type in your application and the instance will be used by the `DecodeJson` type class. 430 | 431 | ### Accumulating Errors Instead of Short-Circuiting 432 | 433 | You may sometimes want to _accumulate_ errors, rather than short-circuit at the first failure. The `V` type from `purescript-validation` is similar to `Either`, but it allows you to accumulate errors into a semigroup or semiring instead of stopping when the first failure occurs. You can define decoders which work in `V` and then convert them back to `Either` at the end. 434 | 435 | For example, let's say we have a `User` type which occasionally gets bad input, and we want to see _all_ errors in the input rather than one at a time. This is how we might write a decoding function for the type: 436 | 437 | ```purs 438 | newtype User = User 439 | { name :: String 440 | , age :: Maybe Int 441 | , location :: String 442 | } 443 | 444 | derive instance newtypeUser :: Newtype User _ 445 | derive newtype instance showUser :: Show User 446 | 447 | decodeUser :: Json -> Either JsonDecodeError User 448 | decodeUser json = do 449 | obj <- decodeJson json 450 | name <- obj .: "name" 451 | age <- obj .:? "age" 452 | location <- obj .: "location" 453 | pure $ User { name, age, location } 454 | ``` 455 | 456 | Running this in the REPL with bad input, we only see the first error: 457 | 458 | ```text 459 | > decodeUser =<< parseJson "{}" 460 | Left (AtKey "name" MissingValue) 461 | ``` 462 | 463 | However, by collecting results into `V` instead of into `Either` we will accumulate all errors. We can even make it a little nicer by writing a new operator, `.:|`, which works in `V`: 464 | 465 | ```purs 466 | -- a replacement for `decodeJson` 467 | decodeJsonV :: forall a. DecodeJson a => Json -> V (Array JsonDecodeError) a 468 | decodeJsonV = either (invalid <<< pure) pure <<< decodeJson 469 | 470 | -- a replacement for `getField` 471 | getFieldV :: forall a. DecodeJson a => Object Json -> String -> V (Array JsonDecodeError) a 472 | getFieldV object key = either (invalid <<< pure) pure (object .: key) 473 | 474 | -- a replacement for .: 475 | infix 7 getFieldV as .:| 476 | ``` 477 | 478 | With this new operator and applicative-do we can recreate our original decoder, except with accumulating errors this time: 479 | 480 | ```purs 481 | decodeUser :: Json -> Either (Array JsonDecodeError) User 482 | decodeUser json = do 483 | user <- toEither $ andThen (decodeJsonV json) \obj -> ado 484 | name <- obj .:| "name" 485 | age <- obj .:| "age" 486 | location <- obj .:| "location" 487 | in { name, age, location } 488 | pure $ User user 489 | ``` 490 | 491 | > Note: If you are doing this in the repl, you can't define an infix operator. Use `getFieldV` in place of `.:|`. 492 | 493 | This decoder will now print all errors: 494 | 495 | ```text 496 | > decodeUser =<< lmap pure (parseJson "{}") 497 | Left 498 | [ AtKey "name" MissingValue 499 | , AtKey "age" MissingValue 500 | , AtKey "location" MissingValue 501 | ] 502 | ``` 503 | -------------------------------------------------------------------------------- /packages.dhall: -------------------------------------------------------------------------------- 1 | let upstream = 2 | https://github.com/purescript/package-sets/releases/download/psc-0.15.2-20220612/packages.dhall 3 | sha256:9876aee1362a5dac10061768c68a7ecc4a59ca9267c3760f7d43ea9d3812ec11 4 | 5 | in upstream 6 | -------------------------------------------------------------------------------- /spago.dhall: -------------------------------------------------------------------------------- 1 | { name = "argonaut-codecs" 2 | , license = "MIT" 3 | , repository = 4 | "https://github.com/purescript-contrib/purescript-argonaut-codecs" 5 | , dependencies = 6 | [ "argonaut-core" 7 | , "arrays" 8 | , "assert" 9 | , "bifunctors" 10 | , "console" 11 | , "const" 12 | , "effect" 13 | , "either" 14 | , "exceptions" 15 | , "foldable-traversable" 16 | , "foreign-object" 17 | , "gen" 18 | , "identity" 19 | , "integers" 20 | , "lists" 21 | , "maybe" 22 | , "nonempty" 23 | , "ordered-collections" 24 | , "prelude" 25 | , "quickcheck" 26 | , "record" 27 | , "strings" 28 | , "transformers" 29 | , "tuples" 30 | ] 31 | , packages = ./packages.dhall 32 | , sources = [ "src/**/*.purs", "test/**/*.purs" ] 33 | } 34 | -------------------------------------------------------------------------------- /src/Data/Argonaut/Decode.purs: -------------------------------------------------------------------------------- 1 | module Data.Argonaut.Decode 2 | ( fromJsonString 3 | , module Data.Argonaut.Decode.Class 4 | , module Data.Argonaut.Decode.Combinators 5 | , module Data.Argonaut.Decode.Error 6 | , module Data.Argonaut.Decode.Parser 7 | ) where 8 | 9 | import Prelude 10 | 11 | import Data.Argonaut.Decode.Class (class DecodeJson, decodeJson) 12 | import Data.Argonaut.Decode.Combinators (getField, getFieldOptional, getFieldOptional', defaultField, (.:), (.:!), (.:?), (.!=)) 13 | import Data.Argonaut.Decode.Error (JsonDecodeError(..), printJsonDecodeError) 14 | import Data.Argonaut.Decode.Parser (parseJson) 15 | import Data.Either (Either) 16 | 17 | -- | Parse and decode a json in one step. 18 | fromJsonString :: forall json. DecodeJson json => String -> Either JsonDecodeError json 19 | fromJsonString = parseJson >=> decodeJson 20 | -------------------------------------------------------------------------------- /src/Data/Argonaut/Decode/Class.purs: -------------------------------------------------------------------------------- 1 | module Data.Argonaut.Decode.Class where 2 | 3 | import Data.Argonaut.Decode.Decoders 4 | 5 | import Data.Argonaut.Core (Json, toObject) 6 | import Data.Argonaut.Decode.Error (JsonDecodeError(..)) 7 | import Data.Array.NonEmpty (NonEmptyArray) 8 | import Data.Bifunctor (lmap) 9 | import Data.Const (Const) 10 | import Data.Either (Either(..)) 11 | import Data.Identity (Identity) 12 | import Data.List (List) 13 | import Data.List.NonEmpty (NonEmptyList) 14 | import Data.String.NonEmpty (NonEmptyString) 15 | import Data.Map as M 16 | import Data.Maybe (Maybe(..)) 17 | import Data.NonEmpty (NonEmpty) 18 | import Data.Set as S 19 | import Data.String (CodePoint) 20 | import Data.Symbol (class IsSymbol, reflectSymbol) 21 | import Data.Tuple (Tuple) 22 | import Foreign.Object as FO 23 | import Prelude (class Ord, Unit, Void, bind, ($), (<$>)) 24 | import Prim.Row as Row 25 | import Prim.RowList as RL 26 | import Record as Record 27 | import Type.Proxy (Proxy(..)) 28 | 29 | class DecodeJson a where 30 | decodeJson :: Json -> Either JsonDecodeError a 31 | 32 | instance decodeIdentity :: DecodeJson a => DecodeJson (Identity a) where 33 | decodeJson = decodeIdentity decodeJson 34 | 35 | instance decodeConst :: DecodeJson a => DecodeJson (Const a b) where 36 | decodeJson = decodeConst decodeJson 37 | 38 | instance decodeJsonMaybe :: DecodeJson a => DecodeJson (Maybe a) where 39 | decodeJson = decodeMaybe decodeJson 40 | 41 | instance decodeJsonTuple :: (DecodeJson a, DecodeJson b) => DecodeJson (Tuple a b) where 42 | decodeJson = decodeTuple decodeJson decodeJson 43 | 44 | instance decodeJsonEither :: (DecodeJson a, DecodeJson b) => DecodeJson (Either a b) where 45 | decodeJson = decodeEither decodeJson decodeJson 46 | 47 | instance decodeJsonNull :: DecodeJson Unit where 48 | decodeJson = decodeNull 49 | 50 | instance decodeJsonBoolean :: DecodeJson Boolean where 51 | decodeJson = decodeBoolean 52 | 53 | instance decodeJsonNumber :: DecodeJson Number where 54 | decodeJson = decodeNumber 55 | 56 | instance decodeJsonInt :: DecodeJson Int where 57 | decodeJson = decodeInt 58 | 59 | instance decodeJsonString :: DecodeJson String where 60 | decodeJson = decodeString 61 | 62 | instance decodeJsonNonEmptyString :: DecodeJson NonEmptyString where 63 | decodeJson = decodeNonEmptyString 64 | 65 | instance decodeJsonJson :: DecodeJson Json where 66 | decodeJson = Right 67 | 68 | instance decodeJsonNonEmpty_Array :: (DecodeJson a) => DecodeJson (NonEmpty Array a) where 69 | decodeJson = decodeNonEmpty_Array decodeJson 70 | 71 | instance decodeJsonNonEmptyArray :: (DecodeJson a) => DecodeJson (NonEmptyArray a) where 72 | decodeJson = decodeNonEmptyArray decodeJson 73 | 74 | instance decodeJsonNonEmpty_List :: (DecodeJson a) => DecodeJson (NonEmpty List a) where 75 | decodeJson = decodeNonEmpty_List decodeJson 76 | 77 | instance decodeJsonNonEmptyList :: (DecodeJson a) => DecodeJson (NonEmptyList a) where 78 | decodeJson = decodeNonEmptyList decodeJson 79 | 80 | instance decodeJsonCodePoint :: DecodeJson CodePoint where 81 | decodeJson = decodeCodePoint 82 | 83 | instance decodeChar :: DecodeJson Char where 84 | decodeJson = decodeChar 85 | 86 | instance decodeForeignObject :: DecodeJson a => DecodeJson (FO.Object a) where 87 | decodeJson = decodeForeignObject decodeJson 88 | 89 | instance decodeArray :: DecodeJson a => DecodeJson (Array a) where 90 | decodeJson = decodeArray decodeJson 91 | 92 | instance decodeList :: DecodeJson a => DecodeJson (List a) where 93 | decodeJson = decodeList decodeJson 94 | 95 | instance decodeSet :: (Ord a, DecodeJson a) => DecodeJson (S.Set a) where 96 | decodeJson = decodeSet decodeJson 97 | 98 | instance decodeMap :: (Ord a, DecodeJson a, DecodeJson b) => DecodeJson (M.Map a b) where 99 | decodeJson = decodeMap decodeJson decodeJson 100 | 101 | instance decodeVoid :: DecodeJson Void where 102 | decodeJson = decodeVoid 103 | 104 | instance decodeRecord :: 105 | ( GDecodeJson row list 106 | , RL.RowToList row list 107 | ) => 108 | DecodeJson (Record row) where 109 | decodeJson json = 110 | case toObject json of 111 | Just object -> gDecodeJson object (Proxy :: Proxy list) 112 | Nothing -> Left $ TypeMismatch "Object" 113 | 114 | class GDecodeJson (row :: Row Type) (list :: RL.RowList Type) | list -> row where 115 | gDecodeJson :: forall proxy. FO.Object Json -> proxy list -> Either JsonDecodeError (Record row) 116 | 117 | instance gDecodeJsonNil :: GDecodeJson () RL.Nil where 118 | gDecodeJson _ _ = Right {} 119 | 120 | instance gDecodeJsonCons :: 121 | ( DecodeJsonField value 122 | , GDecodeJson rowTail tail 123 | , IsSymbol field 124 | , Row.Cons field value rowTail row 125 | , Row.Lacks field rowTail 126 | ) => 127 | GDecodeJson row (RL.Cons field value tail) where 128 | gDecodeJson object _ = do 129 | let 130 | _field = Proxy :: Proxy field 131 | fieldName = reflectSymbol _field 132 | fieldValue = FO.lookup fieldName object 133 | 134 | case decodeJsonField fieldValue of 135 | Just fieldVal -> do 136 | val <- lmap (AtKey fieldName) fieldVal 137 | rest <- gDecodeJson object (Proxy :: Proxy tail) 138 | Right $ Record.insert _field val rest 139 | 140 | Nothing -> 141 | Left $ AtKey fieldName MissingValue 142 | 143 | class DecodeJsonField a where 144 | decodeJsonField :: Maybe Json -> Maybe (Either JsonDecodeError a) 145 | 146 | instance decodeFieldMaybe :: 147 | DecodeJson a => 148 | DecodeJsonField (Maybe a) where 149 | decodeJsonField Nothing = Just $ Right Nothing 150 | decodeJsonField (Just j) = Just $ decodeJson j 151 | 152 | else instance decodeFieldId :: 153 | DecodeJson a => 154 | DecodeJsonField a where 155 | decodeJsonField j = decodeJson <$> j 156 | -------------------------------------------------------------------------------- /src/Data/Argonaut/Decode/Combinators.purs: -------------------------------------------------------------------------------- 1 | module Data.Argonaut.Decode.Combinators 2 | ( getField 3 | , getFieldOptional 4 | , getFieldOptional' 5 | , defaultField 6 | , (.:) 7 | , (.:!) 8 | , (.:?) 9 | , (.!=) 10 | ) where 11 | 12 | import Prelude 13 | 14 | import Data.Argonaut.Core (Json) 15 | import Data.Argonaut.Decode.Error (JsonDecodeError) 16 | import Data.Argonaut.Decode.Class (class DecodeJson, decodeJson) 17 | import Data.Either (Either) 18 | import Data.Maybe (Maybe, fromMaybe) 19 | import Foreign.Object as FO 20 | import Data.Argonaut.Decode.Decoders as Decoders 21 | 22 | -- | Attempt to get the value for a given key on an `Object Json`. 23 | -- | 24 | -- | Use this accessor if the key and value *must* be present in your object. 25 | -- | If the key and value are optional, use `getFieldOptional'` (`.:?`) instead. 26 | getField :: forall a. DecodeJson a => FO.Object Json -> String -> Either JsonDecodeError a 27 | getField = Decoders.getField decodeJson 28 | 29 | infix 7 getField as .: 30 | 31 | -- | Attempt to get the value for a given key on an `Object Json`. 32 | -- | 33 | -- | The result will be `Right Nothing` if the key and value are not present, 34 | -- | or if the key is present and the value is `null`. 35 | -- | 36 | -- | Use this accessor if the key and value are optional in your object. 37 | -- | If the key and value are mandatory, use `getField` (`.:`) instead. 38 | getFieldOptional' :: forall a. DecodeJson a => FO.Object Json -> String -> Either JsonDecodeError (Maybe a) 39 | getFieldOptional' = Decoders.getFieldOptional' decodeJson 40 | 41 | infix 7 getFieldOptional' as .:? 42 | 43 | -- | Attempt to get the value for a given key on an `Object Json`. 44 | -- | 45 | -- | The result will be `Right Nothing` if the key and value are not present, 46 | -- | but will fail if the key is present but the value cannot be converted to the right type. 47 | -- | 48 | -- | This function will treat `null` as a value and attempt to decode it into your desired type. 49 | -- | If you would like to treat `null` values the same as absent values, use 50 | -- | `getFieldOptional'` (`.:?`) instead. 51 | getFieldOptional :: forall a. DecodeJson a => FO.Object Json -> String -> Either JsonDecodeError (Maybe a) 52 | getFieldOptional = Decoders.getFieldOptional decodeJson 53 | 54 | infix 7 getFieldOptional as .:! 55 | 56 | -- | Helper for use in combination with `.:?` to provide default values for optional 57 | -- | `Object Json` fields. 58 | -- | 59 | -- | Example usage: 60 | -- | ```purs 61 | -- | newtype MyType = MyType 62 | -- | { foo :: String 63 | -- | , bar :: Maybe Int 64 | -- | , baz :: Boolean 65 | -- | } 66 | -- | 67 | -- | instance decodeJsonMyType :: DecodeJson MyType where 68 | -- | decodeJson json = do 69 | -- | x <- decodeJson json 70 | -- | foo <- x .: "foo" -- mandatory field 71 | -- | bar <- x .:? "bar" -- optional field 72 | -- | baz <- x .:? "baz" .!= false -- optional field with default value of `false` 73 | -- | pure $ MyType { foo, bar, baz } 74 | -- | ``` 75 | defaultField :: forall a. Either JsonDecodeError (Maybe a) -> a -> Either JsonDecodeError a 76 | defaultField parser default = fromMaybe default <$> parser 77 | 78 | infix 6 defaultField as .!= 79 | -------------------------------------------------------------------------------- /src/Data/Argonaut/Decode/Decoders.purs: -------------------------------------------------------------------------------- 1 | module Data.Argonaut.Decode.Decoders where 2 | 3 | import Prelude 4 | 5 | import Data.Argonaut.Core (Json, caseJsonBoolean, caseJsonNull, caseJsonNumber, caseJsonString, isNull, toArray, toObject, toString, fromString) 6 | import Data.Argonaut.Decode.Error (JsonDecodeError(..)) 7 | import Data.Array as Arr 8 | import Data.Array.NonEmpty (NonEmptyArray) 9 | import Data.Array.NonEmpty as NEA 10 | import Data.Bifunctor (lmap) 11 | import Data.Const (Const(..)) 12 | import Data.Either (Either(..), note) 13 | import Data.Identity (Identity(..)) 14 | import Data.Int (fromNumber) 15 | import Data.List (List, fromFoldable) 16 | import Data.List as L 17 | import Data.List.NonEmpty (NonEmptyList) 18 | import Data.List.NonEmpty as NEL 19 | import Data.String.NonEmpty (NonEmptyString) 20 | import Data.String.NonEmpty as NonEmptyString 21 | import Data.Map as M 22 | import Data.Maybe (maybe, Maybe(..)) 23 | import Data.NonEmpty (NonEmpty, (:|)) 24 | import Data.Set as S 25 | import Data.String (CodePoint, codePointAt) 26 | import Data.Traversable (traverse) 27 | import Data.TraversableWithIndex (traverseWithIndex) 28 | import Data.Tuple (Tuple(..)) 29 | import Foreign.Object as FO 30 | import Data.String.CodeUnits (toChar) as CU 31 | 32 | decodeIdentity 33 | :: forall a 34 | . (Json -> Either JsonDecodeError a) 35 | -> Json 36 | -> Either JsonDecodeError (Identity a) 37 | decodeIdentity decoder json = Identity <$> decoder json 38 | 39 | decodeConst 40 | :: forall a b 41 | . (Json -> Either JsonDecodeError a) 42 | -> Json 43 | -> Either JsonDecodeError (Const a b) 44 | decodeConst decoder json = Const <$> decoder json 45 | 46 | decodeMaybe 47 | :: forall a 48 | . (Json -> Either JsonDecodeError a) 49 | -> Json 50 | -> Either JsonDecodeError (Maybe a) 51 | decodeMaybe decoder json 52 | | isNull json = pure Nothing 53 | | otherwise = Just <$> decoder json 54 | 55 | decodeTuple 56 | :: forall a b 57 | . (Json -> Either JsonDecodeError a) 58 | -> (Json -> Either JsonDecodeError b) 59 | -> Json 60 | -> Either JsonDecodeError (Tuple a b) 61 | decodeTuple decoderA decoderB json = decodeArray Right json >>= f 62 | where 63 | f :: Array Json -> Either JsonDecodeError (Tuple a b) 64 | f = case _ of 65 | [ a, b ] -> Tuple <$> decoderA a <*> decoderB b 66 | _ -> Left $ TypeMismatch "Tuple" 67 | 68 | decodeEither 69 | :: forall a b 70 | . (Json -> Either JsonDecodeError a) 71 | -> (Json -> Either JsonDecodeError b) 72 | -> Json 73 | -> Either JsonDecodeError (Either a b) 74 | decodeEither decoderA decoderB json = 75 | lmap (Named "Either") $ decodeJObject json >>= \obj -> do 76 | tag <- note (AtKey "tag" MissingValue) $ FO.lookup "tag" obj 77 | val <- note (AtKey "value" MissingValue) $ FO.lookup "value" obj 78 | case toString tag of 79 | Just "Right" -> Right <$> decoderB val 80 | Just "Left" -> Left <$> decoderA val 81 | _ -> Left $ AtKey "tag" (UnexpectedValue tag) 82 | 83 | decodeNull :: Json -> Either JsonDecodeError Unit 84 | decodeNull = caseJsonNull (Left $ TypeMismatch "null") (const $ Right unit) 85 | 86 | decodeBoolean :: Json -> Either JsonDecodeError Boolean 87 | decodeBoolean = caseJsonBoolean (Left $ TypeMismatch "Boolean") Right 88 | 89 | decodeNumber :: Json -> Either JsonDecodeError Number 90 | decodeNumber = caseJsonNumber (Left $ TypeMismatch "Number") Right 91 | 92 | decodeInt :: Json -> Either JsonDecodeError Int 93 | decodeInt = note (TypeMismatch "Integer") <<< fromNumber <=< decodeNumber 94 | 95 | decodeString :: Json -> Either JsonDecodeError String 96 | decodeString = caseJsonString (Left $ TypeMismatch "String") Right 97 | 98 | decodeNonEmptyString :: Json -> Either JsonDecodeError NonEmptyString 99 | decodeNonEmptyString json = 100 | note (Named "NonEmptyString" $ UnexpectedValue json) 101 | =<< map (NonEmptyString.fromString) (decodeString json) 102 | 103 | decodeNonEmpty_Array 104 | :: forall a 105 | . (Json -> Either JsonDecodeError a) 106 | -> Json 107 | -> Either JsonDecodeError (NonEmpty Array a) 108 | decodeNonEmpty_Array decoder = 109 | lmap (Named "NonEmpty Array") 110 | <<< traverse decoder 111 | <=< map (\x -> x.head :| x.tail) 112 | <<< note (TypeMismatch "NonEmpty Array") 113 | <<< Arr.uncons 114 | <=< decodeJArray 115 | 116 | decodeNonEmptyArray 117 | :: forall a 118 | . (Json -> Either JsonDecodeError a) 119 | -> Json 120 | -> Either JsonDecodeError (NonEmptyArray a) 121 | decodeNonEmptyArray decoder = 122 | lmap (Named "NonEmptyArray") 123 | <<< traverse decoder 124 | <=< map (\x -> NEA.cons' x.head x.tail) 125 | <<< note (TypeMismatch "NonEmptyArray") 126 | <<< Arr.uncons 127 | <=< decodeJArray 128 | 129 | decodeNonEmpty_List 130 | :: forall a 131 | . (Json -> Either JsonDecodeError a) 132 | -> Json 133 | -> Either JsonDecodeError (NonEmpty List a) 134 | decodeNonEmpty_List decoder = 135 | lmap (Named "NonEmpty List") 136 | <<< traverse decoder 137 | <=< map (\x -> x.head :| x.tail) 138 | <<< note (TypeMismatch "NonEmpty List") 139 | <<< L.uncons 140 | <=< map (map fromFoldable) decodeJArray 141 | 142 | decodeNonEmptyList 143 | :: forall a 144 | . (Json -> Either JsonDecodeError a) 145 | -> Json 146 | -> Either JsonDecodeError (NonEmptyList a) 147 | decodeNonEmptyList decoder = 148 | lmap (Named "NonEmptyList") 149 | <<< traverse decoder 150 | <=< map (\x -> NEL.cons' x.head x.tail) 151 | <<< note (TypeMismatch "NonEmptyList") 152 | <<< L.uncons 153 | <=< map (map fromFoldable) decodeJArray 154 | 155 | decodeCodePoint :: Json -> Either JsonDecodeError CodePoint 156 | decodeCodePoint json = 157 | note (Named "CodePoint" $ UnexpectedValue json) 158 | =<< map (codePointAt 0) (decodeString json) 159 | 160 | decodeChar :: Json -> Either JsonDecodeError Char 161 | decodeChar json = 162 | note (Named "Char" $ UnexpectedValue json) 163 | =<< map CU.toChar (decodeString json) 164 | 165 | decodeForeignObject 166 | :: forall a 167 | . (Json -> Either JsonDecodeError a) 168 | -> Json 169 | -> Either JsonDecodeError (FO.Object a) 170 | decodeForeignObject decoder = 171 | lmap (Named "ForeignObject") 172 | <<< traverse decoder 173 | <=< decodeJObject 174 | 175 | decodeArray 176 | :: forall a 177 | . (Json -> Either JsonDecodeError a) 178 | -> Json 179 | -> Either JsonDecodeError (Array a) 180 | decodeArray decoder = 181 | lmap (Named "Array") 182 | <<< traverseWithIndex (\i -> lmap (AtIndex i) <<< decoder) 183 | <=< decodeJArray 184 | 185 | decodeList 186 | :: forall a 187 | . (Json -> Either JsonDecodeError a) 188 | -> Json 189 | -> Either JsonDecodeError (List a) 190 | decodeList decoder = 191 | lmap (Named "List") 192 | <<< traverse decoder 193 | <=< map (map fromFoldable) decodeJArray 194 | 195 | decodeSet 196 | :: forall a 197 | . Ord a 198 | => (Json -> Either JsonDecodeError a) 199 | -> Json 200 | -> Either JsonDecodeError (S.Set a) 201 | decodeSet decoder = 202 | map (S.fromFoldable :: List a -> S.Set a) <<< decodeList decoder 203 | 204 | decodeMap 205 | :: forall a b 206 | . Ord a 207 | => (Json -> Either JsonDecodeError a) 208 | -> (Json -> Either JsonDecodeError b) 209 | -> Json 210 | -> Either JsonDecodeError (M.Map a b) 211 | decodeMap decoderA decoderB = 212 | map (M.fromFoldable :: List (Tuple a b) -> M.Map a b) 213 | <<< decodeList (decodeTuple decoderA decoderB) 214 | 215 | decodeVoid :: Json -> Either JsonDecodeError Void 216 | decodeVoid _ = Left $ UnexpectedValue $ fromString "Value cannot be Void" 217 | 218 | decodeJArray :: Json -> Either JsonDecodeError (Array Json) 219 | decodeJArray = note (TypeMismatch "Array") <<< toArray 220 | 221 | decodeJObject :: Json -> Either JsonDecodeError (FO.Object Json) 222 | decodeJObject = note (TypeMismatch "Object") <<< toObject 223 | 224 | getField 225 | :: forall a 226 | . (Json -> Either JsonDecodeError a) 227 | -> FO.Object Json 228 | -> String 229 | -> Either JsonDecodeError a 230 | getField decoder obj str = 231 | maybe 232 | (Left $ AtKey str MissingValue) 233 | (lmap (AtKey str) <<< decoder) 234 | (FO.lookup str obj) 235 | 236 | getFieldOptional 237 | :: forall a 238 | . (Json -> Either JsonDecodeError a) 239 | -> FO.Object Json 240 | -> String 241 | -> Either JsonDecodeError (Maybe a) 242 | getFieldOptional decoder obj str = 243 | maybe (pure Nothing) (map Just <<< decode) (FO.lookup str obj) 244 | where 245 | decode = lmap (AtKey str) <<< decoder 246 | 247 | getFieldOptional' 248 | :: forall a 249 | . (Json -> Either JsonDecodeError a) 250 | -> FO.Object Json 251 | -> String 252 | -> Either JsonDecodeError (Maybe a) 253 | getFieldOptional' decoder obj str = 254 | maybe (pure Nothing) decode (FO.lookup str obj) 255 | where 256 | decode json = 257 | if isNull json then 258 | pure Nothing 259 | else 260 | Just <$> (lmap (AtKey str) <<< decoder) json 261 | -------------------------------------------------------------------------------- /src/Data/Argonaut/Decode/Error.purs: -------------------------------------------------------------------------------- 1 | -- | Originally implemented in: 2 | -- | https://github.com/garyb/purescript-codec-argonaut 3 | module Data.Argonaut.Decode.Error where 4 | 5 | import Prelude 6 | 7 | import Data.Argonaut.Core (Json, stringify) 8 | import Data.Generic.Rep (class Generic) 9 | 10 | -- | Error type for failures while decoding. 11 | data JsonDecodeError 12 | = TypeMismatch String 13 | | UnexpectedValue Json 14 | | AtIndex Int JsonDecodeError 15 | | AtKey String JsonDecodeError 16 | | Named String JsonDecodeError 17 | | MissingValue 18 | 19 | derive instance eqJsonDecodeError :: Eq JsonDecodeError 20 | derive instance ordJsonDecodeError :: Ord JsonDecodeError 21 | derive instance genericJsonDecodeError :: Generic JsonDecodeError _ 22 | 23 | instance showJsonDecodeError :: Show JsonDecodeError where 24 | show = case _ of 25 | TypeMismatch s -> "(TypeMismatch " <> show s <> ")" 26 | UnexpectedValue j -> "(UnexpectedValue " <> stringify j <> ")" 27 | AtIndex i e -> "(AtIndex " <> show i <> " " <> show e <> ")" 28 | AtKey k e -> "(AtKey " <> show k <> " " <> show e <> ")" 29 | Named s e -> "(Named " <> show s <> " " <> show e <> ")" 30 | MissingValue -> "MissingValue" 31 | 32 | -- | Prints a `JsonDecodeError` as a readable error message. 33 | printJsonDecodeError :: JsonDecodeError -> String 34 | printJsonDecodeError err = 35 | "An error occurred while decoding a JSON value:\n" <> go err 36 | where 37 | go = case _ of 38 | TypeMismatch ty -> " Expected value of type '" <> ty <> "'." 39 | UnexpectedValue val -> " Unexpected value " <> stringify val <> "." 40 | AtIndex ix inner -> " At array index " <> show ix <> ":\n" <> go inner 41 | AtKey key inner -> " At object key \'" <> key <> "\':\n" <> go inner 42 | Named name inner -> " Under '" <> name <> "':\n" <> go inner 43 | MissingValue -> " No value was found." 44 | -------------------------------------------------------------------------------- /src/Data/Argonaut/Decode/Parser.purs: -------------------------------------------------------------------------------- 1 | module Data.Argonaut.Decode.Parser where 2 | 3 | import Prelude 4 | 5 | import Data.Argonaut.Core (Json) 6 | import Data.Argonaut.Decode.Error (JsonDecodeError(..)) 7 | import Data.Argonaut.Parser (jsonParser) 8 | import Data.Bifunctor (lmap) 9 | import Data.Either (Either) 10 | 11 | -- | Attempt to parse a string as `Json`, failing with a typed error if the 12 | -- | JSON string is malformed. 13 | parseJson :: String -> Either JsonDecodeError Json 14 | parseJson = lmap (\_ -> TypeMismatch "JSON") <<< jsonParser 15 | -------------------------------------------------------------------------------- /src/Data/Argonaut/Encode.purs: -------------------------------------------------------------------------------- 1 | module Data.Argonaut.Encode 2 | ( module Data.Argonaut.Encode.Class 3 | , module Data.Argonaut.Encode.Combinators 4 | , toJsonString 5 | ) where 6 | 7 | import Prelude 8 | 9 | import Data.Argonaut.Core (stringify) 10 | import Data.Argonaut.Encode.Class (class EncodeJson, encodeJson) 11 | import Data.Argonaut.Encode.Combinators (assoc, assocOptional, extend, extendOptional, (:=), (:=?), (~>), (~>?)) 12 | 13 | -- | Encode and stringify a type in one step. 14 | toJsonString :: forall t. EncodeJson t => t -> String 15 | toJsonString = encodeJson >>> stringify 16 | -------------------------------------------------------------------------------- /src/Data/Argonaut/Encode/Class.purs: -------------------------------------------------------------------------------- 1 | module Data.Argonaut.Encode.Class where 2 | 3 | import Data.Argonaut.Encode.Encoders 4 | 5 | import Data.Argonaut.Core (Json, fromObject) 6 | import Data.Array.NonEmpty (NonEmptyArray) 7 | import Data.String.NonEmpty (NonEmptyString) 8 | import Data.Const (Const) 9 | import Data.Either (Either) 10 | import Data.Identity (Identity) 11 | import Data.List (List) 12 | import Data.List.Types (NonEmptyList) 13 | import Data.Map as M 14 | import Data.Maybe (Maybe) 15 | import Data.NonEmpty (NonEmpty) 16 | import Data.Set as S 17 | import Data.String (CodePoint) 18 | import Data.Symbol (class IsSymbol, reflectSymbol) 19 | import Data.Tuple (Tuple) 20 | import Foreign.Object as FO 21 | import Prelude (class Ord, Unit, Void, identity, ($)) 22 | import Prim.Row as Row 23 | import Prim.RowList as RL 24 | import Record as Record 25 | import Type.Proxy (Proxy(..)) 26 | 27 | class EncodeJson a where 28 | encodeJson :: a -> Json 29 | 30 | instance encodeIdentity :: EncodeJson a => EncodeJson (Identity a) where 31 | encodeJson = encodeIdentity encodeJson 32 | 33 | instance encodeConst :: EncodeJson a => EncodeJson (Const a b) where 34 | encodeJson = encodeConst encodeJson 35 | 36 | instance encodeJsonMaybe :: EncodeJson a => EncodeJson (Maybe a) where 37 | encodeJson = encodeMaybe encodeJson 38 | 39 | instance encodeJsonTuple :: (EncodeJson a, EncodeJson b) => EncodeJson (Tuple a b) where 40 | encodeJson = encodeTuple encodeJson encodeJson 41 | 42 | instance encodeJsonEither :: (EncodeJson a, EncodeJson b) => EncodeJson (Either a b) where 43 | encodeJson = encodeEither encodeJson encodeJson 44 | 45 | instance encodeJsonUnit :: EncodeJson Unit where 46 | encodeJson = encodeUnit 47 | 48 | instance encodeJsonJBoolean :: EncodeJson Boolean where 49 | encodeJson = encodeBoolean 50 | 51 | instance encodeJsonJNumber :: EncodeJson Number where 52 | encodeJson = encodeNumber 53 | 54 | instance encodeJsonInt :: EncodeJson Int where 55 | encodeJson = encodeInt 56 | 57 | instance encodeJsonJString :: EncodeJson String where 58 | encodeJson = encodeString 59 | 60 | instance encodeJsonJson :: EncodeJson Json where 61 | encodeJson = identity 62 | 63 | instance encodeJsonCodePoint :: EncodeJson CodePoint where 64 | encodeJson = encodeCodePoint 65 | 66 | instance encodeNonEmptyString :: EncodeJson NonEmptyString where 67 | encodeJson = encodeNonEmptyString 68 | 69 | instance encodeJsonNonEmpty_Array :: (EncodeJson a) => EncodeJson (NonEmpty Array a) where 70 | encodeJson = encodeNonEmpty_Array encodeJson 71 | 72 | instance encodeJsonNonEmptyArray :: (EncodeJson a) => EncodeJson (NonEmptyArray a) where 73 | encodeJson = encodeNonEmptyArray encodeJson 74 | 75 | instance encodeJsonNonEmpty_List :: (EncodeJson a) => EncodeJson (NonEmpty List a) where 76 | encodeJson = encodeNonEmpty_List encodeJson 77 | 78 | instance encodeJsonNonEmptyList :: (EncodeJson a) => EncodeJson (NonEmptyList a) where 79 | encodeJson = encodeNonEmptyList encodeJson 80 | 81 | instance encodeJsonChar :: EncodeJson Char where 82 | encodeJson = encodeChar 83 | 84 | instance encodeJsonArray :: EncodeJson a => EncodeJson (Array a) where 85 | encodeJson = encodeArray encodeJson 86 | 87 | instance encodeJsonList :: EncodeJson a => EncodeJson (List a) where 88 | encodeJson = encodeList encodeJson 89 | 90 | instance encodeForeignObject :: EncodeJson a => EncodeJson (FO.Object a) where 91 | encodeJson = encodeForeignObject encodeJson 92 | 93 | instance encodeSet :: (Ord a, EncodeJson a) => EncodeJson (S.Set a) where 94 | encodeJson = encodeSet encodeJson 95 | 96 | instance encodeMap :: (Ord a, EncodeJson a, EncodeJson b) => EncodeJson (M.Map a b) where 97 | encodeJson = encodeMap encodeJson encodeJson 98 | 99 | instance encodeVoid :: EncodeJson Void where 100 | encodeJson = encodeVoid 101 | 102 | instance encodeRecord :: 103 | ( GEncodeJson row list 104 | , RL.RowToList row list 105 | ) => 106 | EncodeJson (Record row) where 107 | encodeJson rec = fromObject $ gEncodeJson rec (Proxy :: Proxy list) 108 | 109 | class GEncodeJson (row :: Row Type) (list :: RL.RowList Type) where 110 | gEncodeJson :: forall proxy. Record row -> proxy list -> FO.Object Json 111 | 112 | instance gEncodeJsonNil :: GEncodeJson row RL.Nil where 113 | gEncodeJson _ _ = FO.empty 114 | 115 | instance gEncodeJsonCons :: 116 | ( EncodeJson value 117 | , GEncodeJson row tail 118 | , IsSymbol field 119 | , Row.Cons field value tail' row 120 | ) => 121 | GEncodeJson row (RL.Cons field value tail) where 122 | gEncodeJson row _ = do 123 | let _field = Proxy :: Proxy field 124 | FO.insert 125 | (reflectSymbol _field) 126 | (encodeJson $ Record.get _field row) 127 | (gEncodeJson row (Proxy :: Proxy tail)) 128 | -------------------------------------------------------------------------------- /src/Data/Argonaut/Encode/Combinators.purs: -------------------------------------------------------------------------------- 1 | -- | Provides operators for a DSL to construct `Json` values: 2 | -- | 3 | -- | ```purs 4 | -- | myJson = 5 | -- | "key1" := value1 6 | -- | ~> "key2" :=? value2 7 | -- | ~>? "key3" := value3 8 | -- | ~> jsonEmptyObject 9 | -- | ``` 10 | module Data.Argonaut.Encode.Combinators where 11 | 12 | import Data.Argonaut.Core (Json) 13 | import Data.Argonaut.Encode.Class (class EncodeJson, encodeJson) 14 | import Data.Maybe (Maybe) 15 | import Data.Tuple (Tuple) 16 | import Data.Argonaut.Encode.Encoders as Encoders 17 | 18 | -- | Creates a `Tuple String Json` entry, representing a key/value pair for 19 | -- | an object. 20 | infix 7 assoc as := 21 | 22 | -- | The named Encoders of the `(:=)` operator. 23 | assoc :: forall a. EncodeJson a => String -> a -> Tuple String Json 24 | assoc = Encoders.assoc encodeJson 25 | 26 | -- | Creates an optional `Tuple String Json` entry, representing an optional 27 | -- | key/value pair for an object. 28 | infix 7 assocOptional as :=? 29 | 30 | -- | The named Encoders of the `(:=?)` operator. 31 | assocOptional 32 | :: forall a 33 | . EncodeJson a 34 | => String 35 | -> Maybe a 36 | -> Maybe (Tuple String Json) 37 | assocOptional = Encoders.assocOptional encodeJson 38 | 39 | -- | Extends a Json object with a `Tuple String Json` property. 40 | infixr 6 extend as ~> 41 | 42 | -- | The named Encoders of the `(~>)` operator. 43 | extend :: forall a. EncodeJson a => Tuple String Json -> a -> Json 44 | extend = Encoders.extend encodeJson 45 | 46 | -- | Optionally extends a Json object with an optional `Tuple String Json` property. 47 | infixr 6 extendOptional as ~>? 48 | 49 | -- | The named Encoders of the `(~>?)` operator. 50 | extendOptional :: forall a. EncodeJson a => Maybe (Tuple String Json) -> a -> Json 51 | extendOptional = Encoders.extendOptional encodeJson 52 | -------------------------------------------------------------------------------- /src/Data/Argonaut/Encode/Encoders.purs: -------------------------------------------------------------------------------- 1 | module Data.Argonaut.Encode.Encoders where 2 | 3 | import Prelude 4 | 5 | import Data.Argonaut.Core (Json, fromArray, fromBoolean, fromNumber, fromObject, fromString, jsonNull, caseJsonObject, jsonSingletonObject) 6 | import Data.Array as Arr 7 | import Data.Array.NonEmpty (NonEmptyArray) 8 | import Data.Array.NonEmpty as NEA 9 | import Data.Const (Const(..)) 10 | import Data.Either (Either, either) 11 | import Data.Identity (Identity(..)) 12 | import Data.Int (toNumber) 13 | import Data.List (List(..), (:), toUnfoldable) 14 | import Data.List.NonEmpty as NEL 15 | import Data.List.Types (NonEmptyList) 16 | import Data.String.NonEmpty (NonEmptyString) 17 | import Data.String.NonEmpty as NonEmptyString 18 | import Data.Map as M 19 | import Data.Maybe (Maybe(..)) 20 | import Data.NonEmpty (NonEmpty(..)) 21 | import Data.Set as S 22 | import Data.String (CodePoint) 23 | import Data.String.CodePoints as CP 24 | import Data.String.CodeUnits as CU 25 | import Data.Tuple (Tuple(..)) 26 | import Foreign.Object as FO 27 | 28 | encodeIdentity :: forall a. (a -> Json) -> Identity a -> Json 29 | encodeIdentity encoder (Identity a) = encoder a 30 | 31 | encodeConst :: forall a b. (a -> Json) -> Const a b -> Json 32 | encodeConst encoder (Const a) = encoder a 33 | 34 | encodeMaybe :: forall a. (a -> Json) -> Maybe a -> Json 35 | encodeMaybe encoder = case _ of 36 | Nothing -> jsonNull 37 | Just a -> encoder a 38 | 39 | encodeTuple :: forall a b. (a -> Json) -> (b -> Json) -> Tuple a b -> Json 40 | encodeTuple encoderA encoderB (Tuple a b) = fromArray [ encoderA a, encoderB b ] 41 | 42 | encodeEither :: forall a b. (a -> Json) -> (b -> Json) -> Either a b -> Json 43 | encodeEither encoderA encoderB = either (obj encoderA "Left") (obj encoderB "Right") 44 | where 45 | obj :: forall c. (c -> Json) -> String -> c -> Json 46 | obj encoder tag x = 47 | fromObject 48 | $ FO.fromFoldable 49 | $ Tuple "tag" (fromString tag) : Tuple "value" (encoder x) : Nil 50 | 51 | encodeUnit :: Unit -> Json 52 | encodeUnit = const jsonNull 53 | 54 | encodeBoolean :: Boolean -> Json 55 | encodeBoolean = fromBoolean 56 | 57 | encodeNumber :: Number -> Json 58 | encodeNumber = fromNumber 59 | 60 | encodeInt :: Int -> Json 61 | encodeInt = fromNumber <<< toNumber 62 | 63 | encodeString :: String -> Json 64 | encodeString = fromString 65 | 66 | encodeCodePoint :: CodePoint -> Json 67 | encodeCodePoint = encodeString <<< CP.singleton 68 | 69 | encodeNonEmptyString :: NonEmptyString -> Json 70 | encodeNonEmptyString = fromString <<< NonEmptyString.toString 71 | 72 | encodeNonEmpty_Array :: forall a. (a -> Json) -> NonEmpty Array a -> Json 73 | encodeNonEmpty_Array encoder (NonEmpty h t) = encodeArray encoder (Arr.cons h t) 74 | 75 | encodeNonEmptyArray :: forall a. (a -> Json) -> NonEmptyArray a -> Json 76 | encodeNonEmptyArray encoder = encodeArray encoder <<< NEA.toArray 77 | 78 | encodeNonEmpty_List :: forall a. (a -> Json) -> NonEmpty List a -> Json 79 | encodeNonEmpty_List encoder (NonEmpty h t) = encodeList encoder (h : t) 80 | 81 | encodeNonEmptyList :: forall a. (a -> Json) -> NonEmptyList a -> Json 82 | encodeNonEmptyList encoder = encodeList encoder <<< NEL.toList 83 | 84 | encodeChar :: Char -> Json 85 | encodeChar = encodeString <<< CU.singleton 86 | 87 | encodeArray :: forall a. (a -> Json) -> Array a -> Json 88 | encodeArray encoder = fromArray <<< map encoder 89 | 90 | encodeList :: forall a. (a -> Json) -> List a -> Json 91 | encodeList encoder = fromArray <<< map encoder <<< toUnfoldable 92 | 93 | encodeForeignObject :: forall a. (a -> Json) -> FO.Object a -> Json 94 | encodeForeignObject encoder = fromObject <<< map encoder 95 | 96 | encodeSet :: forall a. Ord a => (a -> Json) -> S.Set a -> Json 97 | encodeSet encoder = encodeList encoder <<< (S.toUnfoldable :: S.Set a -> List a) 98 | 99 | encodeMap :: forall a b. Ord a => (a -> Json) -> (b -> Json) -> M.Map a b -> Json 100 | encodeMap encoderA encoderB = 101 | encodeList (encodeTuple encoderA encoderB) 102 | <<< (M.toUnfoldable :: M.Map a b -> List (Tuple a b)) 103 | 104 | encodeVoid :: Void -> Json 105 | encodeVoid = absurd 106 | 107 | assoc :: forall a. (a -> Json) -> String -> a -> Tuple String Json 108 | assoc encoder k = Tuple k <<< encoder 109 | 110 | assocOptional 111 | :: forall a 112 | . (a -> Json) 113 | -> String 114 | -> Maybe a 115 | -> Maybe (Tuple String Json) 116 | assocOptional encoder k = map (Tuple k <<< encoder) 117 | 118 | extend :: forall a. (a -> Json) -> Tuple String Json -> a -> Json 119 | extend encoder (Tuple k v) = 120 | caseJsonObject (jsonSingletonObject k v) (fromObject <<< FO.insert k v) 121 | <<< encoder 122 | 123 | -- | The named Encoders of the `(~>?)` operator. 124 | extendOptional :: forall a. (a -> Json) -> Maybe (Tuple String Json) -> a -> Json 125 | extendOptional encoder = case _ of 126 | Just kv -> extend encoder kv 127 | Nothing -> encoder 128 | -------------------------------------------------------------------------------- /test/Test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Gen.Common (genMaybe) 6 | import Control.Monad.Reader (ReaderT, ask, local, runReaderT) 7 | import Data.Argonaut.Core (Json, isObject, stringify, toObject) 8 | import Data.Argonaut.Decode (class DecodeJson, decodeJson, (.:), (.:!), (.:?), (.!=)) 9 | import Data.Argonaut.Decode.Error (JsonDecodeError, printJsonDecodeError) 10 | import Data.Argonaut.Encode (encodeJson, (:=), (:=?), (~>), (~>?)) 11 | import Data.Argonaut.Gen (genJson) 12 | import Data.Argonaut.Parser (jsonParser) 13 | import Data.Array.NonEmpty (NonEmptyArray) 14 | import Data.String.NonEmpty (NonEmptyString) 15 | import Data.String.NonEmpty as NonEmptyString 16 | import Data.Bifunctor (rmap) 17 | import Data.Either (Either(..), either) 18 | import Data.Foldable (foldl) 19 | import Data.List (List) 20 | import Data.List as List 21 | import Data.List.Types (NonEmptyList) 22 | import Data.Maybe (Maybe(..), isJust, isNothing, maybe) 23 | import Data.Monoid (power) 24 | import Data.NonEmpty (NonEmpty) 25 | import Data.String (joinWith) 26 | import Data.String.Gen (genUnicodeString) 27 | import Data.Tuple (Tuple(..)) 28 | import Effect (Effect) 29 | import Effect.Class (liftEffect) 30 | import Effect.Class.Console (log) 31 | import Effect.Exception (throw) 32 | import Foreign.Object as FO 33 | import Test.Assert as Assert 34 | import Test.QuickCheck (Result(..), unSeed, (), (===)) 35 | import Test.QuickCheck as LCG 36 | import Test.QuickCheck as QC 37 | import Test.QuickCheck.Arbitrary (arbitrary) 38 | import Test.QuickCheck.Gen (Gen, resize, suchThat) 39 | 40 | type Test = ReaderT Int Effect Unit 41 | 42 | suite :: String -> Test -> Test 43 | suite = test 44 | 45 | test :: String -> Test -> Test 46 | test name run = do 47 | indent <- ask 48 | log (mkIndent indent <> name) 49 | local (_ + 2) run 50 | 51 | mkIndent :: Int -> String 52 | mkIndent = power " " 53 | 54 | assertEqual :: forall a. Eq a => Show a => { actual :: a, expected :: a } -> Test 55 | assertEqual = liftEffect <<< Assert.assertEqual 56 | 57 | quickCheck :: forall prop. QC.Testable prop => prop -> Test 58 | quickCheck prop = liftEffect do 59 | seed <- LCG.randomSeed 60 | let summary = QC.checkResults (QC.quickCheckPure' seed 100 prop) 61 | case List.head summary.failures of 62 | Nothing -> pure unit 63 | Just err -> throw $ "Property failed (seed " <> show (unSeed err.seed) <> ") failed: \n" <> err.message 64 | 65 | failure :: String -> Test 66 | failure = liftEffect <<< throw 67 | 68 | jsonParser' :: String -> ReaderT Int Effect Json 69 | jsonParser' = either (liftEffect <<< throw) pure <<< jsonParser 70 | 71 | main :: Effect Unit 72 | main = flip runReaderT 0 do 73 | suite "Either Check" eitherCheck 74 | suite "Char Check" charCheck 75 | suite "Encode/Decode NonEmpty Check" nonEmptyCheck 76 | suite "Encode/Decode Checks" encodeDecodeCheck 77 | suite "Encode/Decode Record Checks" encodeDecodeRecordCheck 78 | suite "Decode Optional Field Check" decodeOptionalFieldCheck 79 | suite "Combinators Checks" combinatorsCheck 80 | suite "Manual Combinators Checks" manualRecordDecode 81 | suite "Error Message Checks" errorMsgCheck 82 | 83 | genTestRecord :: Gen { i :: Int, n :: Number, s :: String } 84 | genTestRecord = arbitrary 85 | 86 | encodeDecodeRecordCheck :: Test 87 | encodeDecodeRecordCheck = do 88 | test "Testing that any record can be encoded and then decoded" do 89 | quickCheck recEncodeThenDecode 90 | 91 | where 92 | recEncodeThenDecode :: Gen Result 93 | recEncodeThenDecode = do 94 | rec <- genTestRecord 95 | let redecoded = decodeJson (encodeJson rec) 96 | pure $ Right rec == redecoded (show redecoded <> " /= Right " <> show rec) 97 | 98 | decodeOptionalFieldCheck :: Test 99 | decodeOptionalFieldCheck = do 100 | barMissingJson <- jsonParser' """{ }""" 101 | barNullJson <- jsonParser' """{ "bar": null }""" 102 | barPresentJson <- jsonParser' """{ "bar": [] }""" 103 | 104 | test "Decode missing field" do 105 | case decodeJson barMissingJson of 106 | Right ({ bar: Nothing } :: FooRecord) -> pure unit 107 | _ -> failure ("Failed to properly decode JSON string: " <> stringify barMissingJson) 108 | 109 | test "Decode null field" do 110 | case decodeJson barNullJson of 111 | Right ({ bar: Nothing } :: FooRecord) -> pure unit 112 | _ -> failure ("Failed to properly decode JSON string: " <> stringify barNullJson) 113 | 114 | test "Decode present field" do 115 | case decodeJson barPresentJson of 116 | Right ({ bar: Just [] } :: FooRecord) -> pure unit 117 | _ -> failure ("Failed to properly decode JSON string: " <> stringify barPresentJson) 118 | 119 | genTestJson :: Gen Json 120 | genTestJson = resize 5 genJson 121 | 122 | encodeDecodeCheck :: Test 123 | encodeDecodeCheck = do 124 | test "Testing that any JSON can be encoded and then decoded" do 125 | quickCheck propEncodeThenDecode 126 | 127 | test "Testing that any JSON can be decoded and then encoded" do 128 | quickCheck propDecodeThenEncode 129 | 130 | where 131 | propEncodeThenDecode :: Gen Result 132 | propEncodeThenDecode = do 133 | json <- genTestJson 134 | let redecoded = decodeJson (encodeJson json) 135 | pure $ Right json == redecoded (show (rmap stringify redecoded) <> " /= Right " <> stringify json) 136 | 137 | propDecodeThenEncode :: Gen Result 138 | propDecodeThenEncode = do 139 | json <- genTestJson 140 | let (decoded :: Either JsonDecodeError Json) = decodeJson json 141 | let reencoded = decoded >>= (encodeJson >>> pure) 142 | pure $ Right json == reencoded (show (rmap stringify reencoded) <> " /= Right " <> stringify json) 143 | 144 | genObj :: Gen Json 145 | genObj = suchThat (resize 5 genJson) isObject 146 | 147 | combinatorsCheck :: Test 148 | combinatorsCheck = do 149 | test "Check assoc builder `:=`" do 150 | quickCheck propAssocBuilderStr 151 | 152 | test "Check assocOptional builder `:=?`" do 153 | quickCheck propAssocOptionalBuilderStr 154 | 155 | test "Check JAssoc append `~>`" do 156 | quickCheck propAssocAppend 157 | 158 | test "Check JAssoc appendOptional `~>?`" do 159 | quickCheck propAssocAppendOptional 160 | 161 | test "Check get field `obj .: 'foo'`" do -- this doesn't really test .: 162 | quickCheck propGetJObjectField 163 | 164 | where 165 | propAssocBuilderStr :: Gen Result 166 | propAssocBuilderStr = do 167 | key <- genUnicodeString 168 | str <- genUnicodeString 169 | let Tuple k json = key := str 170 | pure $ Tuple key (decodeJson json) === Tuple k (Right str) 171 | 172 | propAssocOptionalBuilderStr :: Gen Result 173 | propAssocOptionalBuilderStr = do 174 | key <- genUnicodeString 175 | maybeStr <- genMaybe genUnicodeString 176 | case key :=? maybeStr of 177 | Just (Tuple k json) -> 178 | pure $ Tuple key (decodeJson json) === Tuple k (Right maybeStr) 179 | Nothing -> 180 | pure Success 181 | 182 | propAssocAppend :: Gen Result 183 | propAssocAppend = do 184 | key <- genUnicodeString 185 | val <- genTestJson 186 | obj <- genObj 187 | let appended = (key := val) ~> obj 188 | case toObject appended >>= FO.lookup key of 189 | Just _ -> pure Success 190 | _ -> pure (Failed "failed to lookup key") 191 | 192 | propAssocAppendOptional :: Gen Result 193 | propAssocAppendOptional = do 194 | key <- genUnicodeString 195 | maybeVal <- genMaybe genTestJson 196 | obj <- genObj 197 | let appended = (key :=? maybeVal) ~>? obj 198 | pure case toObject appended >>= FO.lookup key of 199 | Just _ -> isJust maybeVal === true 200 | _ -> isNothing maybeVal === true 201 | 202 | propGetJObjectField :: Gen Result 203 | propGetJObjectField = do 204 | obj <- genObj 205 | pure (true === maybe false go (toObject obj)) 206 | 207 | where 208 | go :: FO.Object Json -> Boolean 209 | go object = 210 | let 211 | keys = FO.keys object 212 | in 213 | foldl (\ok key -> ok && isJust (FO.lookup key object)) true keys 214 | 215 | eitherCheck :: Test 216 | eitherCheck = do 217 | test "Test EncodeJson/DecodeJson Either test" do 218 | quickCheck \(x :: Either String String) -> 219 | case decodeJson (encodeJson x) of 220 | Right decoded -> 221 | decoded == x 222 | ("x = " <> show x <> ", decoded = " <> show decoded) 223 | Left err -> 224 | false printJsonDecodeError err 225 | 226 | charCheck :: Test 227 | charCheck = do 228 | test "Test EncodeJson/DecodeJson Char test" do 229 | quickCheck \(x :: Char) -> 230 | case decodeJson (encodeJson x) of 231 | Right decoded -> 232 | decoded == x 233 | ("x = " <> show x <> ", decoded = " <> show decoded) 234 | Left err -> 235 | false printJsonDecodeError err 236 | 237 | manualRecordDecode :: Test 238 | manualRecordDecode = do 239 | fooJson <- jsonParser' """{ "bar": [1, 2, 3], "baz": true }""" 240 | 241 | fooNestedEmptyJson <- jsonParser' "{ }" 242 | 243 | fooNestedEmptyJsonNull <- jsonParser' """{ "bar": null, "baz": null }""" 244 | 245 | fooNestedBazJson <- jsonParser' """{ "baz": true }""" 246 | 247 | fooNestedBazJsonNull <- jsonParser' """{ "bar": null, "baz": true }""" 248 | 249 | fooNestedBarJson <- jsonParser' """{ "bar": [1] }""" 250 | 251 | fooNestedBarJsonNull <- jsonParser' """{ "bar": [1], "baz": null }""" 252 | 253 | fooNestedFullJson <- jsonParser' """{ "bar": [1], "baz": true }""" 254 | 255 | let 256 | testEmptyCases :: Test 257 | testEmptyCases = do 258 | test "Empty Json should decode to FooNested" do 259 | case decodeJson fooNestedEmptyJson of 260 | Right (FooNested { bar: Nothing, baz: false }) -> pure unit 261 | _ -> failure ("Failed to properly decode JSON string: " <> stringify fooNestedEmptyJson) 262 | 263 | test "Json with null values should fail to decode to FooNested" do 264 | case decodeJson fooNestedEmptyJsonNull of 265 | Right (FooNested _) -> failure ("Should have failed to decode JSON string: " <> stringify fooNestedEmptyJsonNull) 266 | _ -> pure unit 267 | 268 | test "Empty Json should decode to FooNested'" do 269 | case decodeJson fooNestedEmptyJson of 270 | Right (FooNested' { bar: Nothing, baz: false }) -> pure unit 271 | _ -> failure ("Failed to properly decode JSON string: " <> stringify fooNestedEmptyJson) 272 | 273 | test "Json with null values should decode to FooNested'" do 274 | case decodeJson fooNestedEmptyJsonNull of 275 | Right (FooNested' { bar: Nothing, baz: false }) -> pure unit 276 | _ -> failure ("Failed to properly decode JSON string: " <> stringify fooNestedEmptyJsonNull) 277 | 278 | testBarCases :: Test 279 | testBarCases = do 280 | test "Missing 'bar' key should decode to FooNested" do 281 | case decodeJson fooNestedBazJson of 282 | Right (FooNested { bar: Nothing, baz: true }) -> pure unit 283 | _ -> failure ("Failed to properly decode JSON string: " <> stringify fooNestedBazJson) 284 | 285 | test "Null 'bar' key should fail to decode to FooNested" do 286 | case decodeJson fooNestedBazJsonNull of 287 | Right (FooNested _) -> failure ("Should have failed to decode JSON string: " <> stringify fooNestedBazJsonNull) 288 | _ -> pure unit 289 | 290 | test "Missing 'bar' key should decode to FooNested'" do 291 | case decodeJson fooNestedBazJson of 292 | Right (FooNested' { bar: Nothing, baz: true }) -> pure unit 293 | _ -> failure ("Failed to properly decode JSON string: " <> stringify fooNestedBazJson) 294 | 295 | test "Null 'bar' key should decode to FooNested'" do 296 | case decodeJson fooNestedBazJsonNull of 297 | Right (FooNested' { bar: Nothing, baz: true }) -> pure unit 298 | _ -> failure ("Failed to properly decode JSON string: " <> stringify fooNestedBazJsonNull) 299 | 300 | testBazCases :: Test 301 | testBazCases = do 302 | test "Missing 'baz' key should decode to FooNested" do 303 | case decodeJson fooNestedBarJson of 304 | Right (FooNested { bar: Just [ 1 ], baz: false }) -> pure unit 305 | _ -> failure ("Failed to properly decode JSON string: " <> stringify fooNestedBarJson) 306 | 307 | test "Null 'baz' key should fail to decode to FooNested" do 308 | case decodeJson fooNestedBarJsonNull of 309 | Right (FooNested _) -> failure ("Should have failed to decode JSON string: " <> stringify fooNestedBarJsonNull) 310 | _ -> pure unit 311 | 312 | test "Missing 'baz' key should decode to FooNested'" do 313 | case decodeJson fooNestedBarJson of 314 | Right (FooNested' { bar: Just [ 1 ], baz: false }) -> pure unit 315 | _ -> failure ("Failed to properly decode JSON string: " <> stringify fooNestedBarJson) 316 | 317 | test "Null 'baz' key should decode to FooNested'" do 318 | case decodeJson fooNestedBarJsonNull of 319 | Right (FooNested' { bar: Just [ 1 ], baz: false }) -> pure unit 320 | _ -> failure ("Failed to properly decode JSON string: " <> stringify fooNestedBarJsonNull) 321 | 322 | testFullCases :: Test 323 | testFullCases = do 324 | test "Json should decode to FooNested" do 325 | case decodeJson fooNestedFullJson of 326 | Right (FooNested { bar: Just [ 1 ], baz: true }) -> pure unit 327 | _ -> failure ("Failed to properly decode JSON string: " <> stringify fooNestedFullJson) 328 | 329 | test "Json should decode to FooNested'" do 330 | case decodeJson fooNestedFullJson of 331 | Right (FooNested { bar: Just [ 1 ], baz: true }) -> pure unit 332 | _ -> failure ("Failed to properly decode JSON string: " <> stringify fooNestedFullJson) 333 | 334 | test "Test that decoding custom record is pure unitful" do 335 | case decodeJson fooJson of 336 | Right (Foo _) -> pure unit 337 | Left err -> failure $ printJsonDecodeError err 338 | 339 | suite "Test decoding empty record" testEmptyCases 340 | suite "Test decoding missing 'bar' key" testBarCases 341 | suite "Test decoding missing 'baz' key" testBazCases 342 | suite "Test decoding with all fields present" testFullCases 343 | 344 | nonEmptyCheck :: Test 345 | nonEmptyCheck = do 346 | test "Test EncodeJson/DecodeJson on NonEmpty Array" do 347 | quickCheck \(x :: NonEmpty Array String) -> 348 | case decodeJson (encodeJson x) of 349 | Right decoded -> 350 | decoded == x 351 | ("x = " <> show x <> ", decoded = " <> show decoded) 352 | Left err -> 353 | false printJsonDecodeError err 354 | 355 | test "Test EncodeJson/DecodeJson on NonEmptyString" do 356 | quickCheck \(x :: NonEmptyString) -> 357 | case decodeJson (encodeJson x) of 358 | Right decoded -> 359 | decoded == x 360 | 361 | ( " x = " 362 | <> NonEmptyString.toString x 363 | <> ", decoded = " 364 | <> NonEmptyString.toString decoded 365 | ) 366 | Left err -> 367 | false printJsonDecodeError err 368 | 369 | test "Test EncodeJson/DecodeJson on NonEmptyArray" do 370 | quickCheck \(x :: NonEmptyArray String) -> 371 | case decodeJson (encodeJson x) of 372 | Right decoded -> 373 | decoded == x 374 | ("x = " <> show x <> ", decoded = " <> show decoded) 375 | Left err -> 376 | false printJsonDecodeError err 377 | 378 | test "Test EncodeJson/DecodeJson on NonEmpty List" do 379 | quickCheck \(x :: NonEmpty List String) -> 380 | case decodeJson (encodeJson x) of 381 | Right decoded -> 382 | decoded == x 383 | ("x = " <> show x <> ", decoded = " <> show decoded) 384 | Left err -> 385 | false printJsonDecodeError err 386 | 387 | test "Test EncodeJson/DecodeJson on NonEmptyList" do 388 | quickCheck \(x :: NonEmptyList String) -> 389 | case decodeJson (encodeJson x) of 390 | Right decoded -> 391 | decoded == x 392 | ("x = " <> show x <> ", decoded = " <> show decoded) 393 | Left err -> 394 | false printJsonDecodeError err 395 | 396 | errorMsgCheck :: Test 397 | errorMsgCheck = do 398 | notBarJson <- jsonParser' """{ "bar": [1, true, 3], "baz": false }""" 399 | notBazJson <- jsonParser' """{ "bar": [1, 2, 3], "baz": 42 }""" 400 | 401 | let 402 | notBar :: Either JsonDecodeError Foo 403 | notBar = decodeJson notBarJson 404 | 405 | notBaz :: Either JsonDecodeError Foo 406 | notBaz = decodeJson notBazJson 407 | 408 | test "Test that decoding array fails with the proper message" do 409 | case notBar of 410 | Left err -> assertEqual { expected: barErr, actual: printJsonDecodeError err } 411 | _ -> failure "Should have failed to decode" 412 | 413 | test "Test that decoding record fails with the proper message" do 414 | case notBaz of 415 | Left err -> assertEqual { expected: bazErr, actual: printJsonDecodeError err } 416 | _ -> failure "Should have failed to decode" 417 | 418 | where 419 | barErr :: String 420 | barErr = 421 | joinWith "\n" 422 | [ "An error occurred while decoding a JSON value:" 423 | , " At object key 'bar':" 424 | , " Under 'Array':" 425 | , " At array index 1:" 426 | , " Expected value of type 'Number'." 427 | ] 428 | 429 | bazErr :: String 430 | bazErr = 431 | joinWith "\n" 432 | [ "An error occurred while decoding a JSON value:" 433 | , " At object key 'baz':" 434 | , " Expected value of type 'Boolean'." 435 | ] 436 | 437 | newtype Foo = Foo 438 | { bar :: Array Int 439 | , baz :: Boolean 440 | } 441 | 442 | instance decodeJsonFoo :: DecodeJson Foo where 443 | decodeJson json = do 444 | x <- decodeJson json 445 | bar <- x .: "bar" 446 | baz <- x .: "baz" 447 | pure $ Foo { bar, baz } 448 | 449 | newtype FooNested = FooNested 450 | { bar :: Maybe (Array Int) 451 | , baz :: Boolean 452 | } 453 | 454 | instance decodeJsonFooNested :: DecodeJson FooNested where 455 | decodeJson json = do 456 | x <- decodeJson json 457 | bar <- x .:! "bar" 458 | baz <- x .:! "baz" .!= false 459 | pure $ FooNested { bar, baz } 460 | 461 | newtype FooNested' = FooNested' 462 | { bar :: Maybe (Array Int) 463 | , baz :: Boolean 464 | } 465 | 466 | instance decodeJsonFooNested' :: DecodeJson FooNested' where 467 | decodeJson json = do 468 | x <- decodeJson json 469 | bar <- x .:? "bar" 470 | baz <- x .:? "baz" .!= false 471 | pure $ FooNested' { bar, baz } 472 | 473 | type FooRecord = 474 | { bar :: Maybe (Array Int) 475 | } 476 | --------------------------------------------------------------------------------