├── docs ├── .gitignore ├── _static │ └── css │ │ └── default.css ├── Makefile ├── with-affjax.md ├── index.rst ├── intro.md ├── faq.md ├── quickstart.md ├── conf.py ├── inferred-record-types.md └── generics-rep.md ├── test ├── index.mjs ├── Util.purs ├── Inferred.purs ├── EnumSumGeneric.purs ├── Generic.purs ├── QuickStart.purs └── Main.purs ├── src └── Simple │ ├── JSON.js │ └── JSON.purs ├── test.bash ├── .gitignore ├── .github └── workflows │ └── ci.yml ├── ci.nix ├── bower.json ├── LICENSE └── README.md /docs/.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | -------------------------------------------------------------------------------- /test/index.mjs: -------------------------------------------------------------------------------- 1 | import { main } from "../output/Test.Main/index.js"; 2 | 3 | main(); 4 | -------------------------------------------------------------------------------- /src/Simple/JSON.js: -------------------------------------------------------------------------------- 1 | export const _parseJSON = JSON.parse; 2 | 3 | export const _undefined = undefined; 4 | 5 | export const _unsafeStringify = JSON.stringify; 6 | -------------------------------------------------------------------------------- /test.bash: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env nix-shell 2 | #! nix-shell ci.nix -i bash 3 | 4 | bower install 5 | 6 | pulp build --include test 7 | 8 | node ./test/index.mjs 9 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /bower_components/ 2 | /node_modules/ 3 | /.pulp-cache/ 4 | /output/ 5 | /generated-docs/ 6 | /.psc-package/ 7 | /.psc* 8 | /.purs* 9 | /.psa* 10 | -------------------------------------------------------------------------------- /docs/_static/css/default.css: -------------------------------------------------------------------------------- 1 | .rst-content pre.literal-block,.rst-content div[class^='highlight'] pre,.rst-content .linenodiv pre { 2 | font-family: SFMono-Regular,Menlo,Monaco,Consolas,"Liberation Mono","Courier New",Courier,monospace; 3 | font-size: 14px; 4 | line-height: 1.5; 5 | } 6 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: ci 2 | 3 | # Run the workflow on any pushes or PRs. 4 | on: [push, pull_request] 5 | 6 | jobs: 7 | tests: 8 | runs-on: ubuntu-latest 9 | steps: 10 | - uses: actions/checkout@v2 11 | - uses: cachix/install-nix-action@v12 12 | with: 13 | nix_path: nixpkgs=channel:nixos-unstable 14 | - run: ./test.bash 15 | -------------------------------------------------------------------------------- /docs/Makefile: -------------------------------------------------------------------------------- 1 | # Minimal makefile for Sphinx documentation 2 | # 3 | 4 | # You can set these variables from the command line. 5 | SPHINXOPTS = 6 | SPHINXBUILD = sphinx-build 7 | SPHINXPROJ = PureScript-Simple-JSON 8 | SOURCEDIR = . 9 | BUILDDIR = _build 10 | 11 | # Put it first so that "make" without argument is like "make help". 12 | help: 13 | @$(SPHINXBUILD) -M help "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) 14 | 15 | .PHONY: help Makefile 16 | 17 | # Catch-all target: route all unknown targets to Sphinx using the new 18 | # "make mode" option. $(O) is meant as a shortcut for $(SPHINXOPTS). 19 | %: Makefile 20 | @$(SPHINXBUILD) -M $@ "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) -------------------------------------------------------------------------------- /ci.nix: -------------------------------------------------------------------------------- 1 | let 2 | nixpkgs = builtins.fetchTarball { 3 | url = "https://github.com/nixos/nixpkgs/archive/39da4240609ee0d8ea533f142ae4c7e25df95980.tar.gz"; 4 | sha256 = "10mp5rjnkl0s6pigbnkdf6pjwm074nf4aq7mwhfwxmz5gs5dpi71"; 5 | }; 6 | in 7 | 8 | { pkgs ? import nixpkgs { } }: 9 | 10 | let 11 | ezPscSrc = pkgs.fetchFromGitHub { 12 | owner = "justinwoo"; 13 | repo = "easy-purescript-nix"; 14 | rev = "0ad5775c1e80cdd952527db2da969982e39ff592"; 15 | sha256 = "0x53ads5v8zqsk4r1mfpzf5913byifdpv5shnvxpgw634ifyj1kg"; 16 | }; 17 | ezPsc = import ezPscSrc { inherit pkgs; }; 18 | in 19 | 20 | pkgs.mkShell { 21 | buildInputs = [ 22 | ezPsc.purs-0_15_0 23 | ezPsc.pulp 24 | pkgs.nodePackages_10_x.bower 25 | ]; 26 | } 27 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-simple-json", 3 | "license": "MIT", 4 | "repository": { 5 | "type": "git", 6 | "url": "git://github.com/justinwoo/purescript-simple-json.git" 7 | }, 8 | "ignore": [ 9 | "**/.*", 10 | "node_modules", 11 | "bower_components", 12 | "output" 13 | ], 14 | "dependencies": { 15 | "purescript-prelude": "^6.0.0", 16 | "purescript-typelevel-prelude": "^7.0.0", 17 | "purescript-record": "^4.0.0", 18 | "purescript-variant": "^8.0.0", 19 | "purescript-nullable": "^6.0.0", 20 | "purescript-foreign-object": "^4.0.0", 21 | "purescript-foreign": "^7.0.0", 22 | "purescript-exceptions": "^6.0.0", 23 | "purescript-arrays": "^7.0.0" 24 | }, 25 | "devDependencies": { 26 | "purescript-assert": "^6.0.0" 27 | } 28 | } 29 | -------------------------------------------------------------------------------- /test/Util.purs: -------------------------------------------------------------------------------- 1 | module Test.Util where 2 | 3 | import Prelude 4 | 5 | import Prim.Row as Row 6 | import Prim.RowList (class RowToList, Cons, Nil, RowList) 7 | import Record (get) 8 | import Type.Prelude (class IsSymbol) 9 | import Type.Proxy (Proxy(..)) 10 | 11 | -- | Check two records of the same type for equality. 12 | equal 13 | :: forall r rs 14 | . RowToList r rs 15 | => EqualFields rs r 16 | => Record r 17 | -> Record r 18 | -> Boolean 19 | equal a b = equalFields (Proxy :: Proxy rs) a b 20 | 21 | class EqualFields (rs :: RowList Type) (row :: Row Type) | rs -> row where 22 | equalFields :: Proxy rs -> Record row -> Record row -> Boolean 23 | 24 | instance equalFieldsCons 25 | :: 26 | ( IsSymbol name 27 | , Eq ty 28 | , Row.Cons name ty tailRow row 29 | , EqualFields tail row 30 | ) => EqualFields (Cons name ty tail) row where 31 | equalFields _ a b = get' a == get' b && rest 32 | where 33 | get' = get (Proxy :: Proxy name) 34 | rest = equalFields (Proxy :: Proxy tail) a b 35 | 36 | instance equalFieldsNil :: EqualFields Nil row where 37 | equalFields _ _ _ = true 38 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2017 Justin Woo 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. -------------------------------------------------------------------------------- /docs/with-affjax.md: -------------------------------------------------------------------------------- 1 | # Usage with Affjax 2 | 3 | There is an issue that discusses how usage with Affjax goes here: 4 | 5 | ## Manually 6 | 7 | In short, you can use the `string` response format for the request: 8 | 9 | ```hs 10 | import Prelude 11 | import Affjax (get, printError) 12 | import Affjax.ResponseFormat (string) 13 | import Data.Either (Either(..)) 14 | import Effect (Effect) 15 | import Effect.Aff (launchAff_) 16 | import Effect.Class.Console (log) 17 | import Simple.JSON (readJSON) 18 | 19 | type MyRecordAlias 20 | = { userId :: Int } 21 | 22 | main :: Effect Unit 23 | main = 24 | launchAff_ 25 | $ do 26 | res <- get string "https://jsonplaceholder.typicode.com/todos/1" 27 | case res of 28 | Left err -> do 29 | log $ "GET /api response failed to decode: " <> printError err 30 | Right response -> do 31 | case readJSON response.body of 32 | Right (r :: MyRecordAlias) -> do 33 | log $ "userID is: " <> show r.userId 34 | Left e -> do 35 | log $ "Can't parse JSON. " <> show e 36 | ``` 37 | 38 | ## With Simple-Ajax 39 | 40 | You can use Dario's library for making requests with Affjax and handling errors with Variant here: 41 | -------------------------------------------------------------------------------- /test/Inferred.purs: -------------------------------------------------------------------------------- 1 | module Test.Inferred where 2 | 3 | import Prelude 4 | 5 | import Control.Alt ((<|>)) 6 | import Control.Monad.Except (runExcept) 7 | import Data.Either (Either(..), isRight) 8 | import Effect (Effect) 9 | import Foreign (Foreign) 10 | import Foreign as Foreign 11 | import Record as Record 12 | import Simple.JSON as JSON 13 | import Test.Assert (assert) 14 | import Type.Proxy (Proxy(..)) 15 | 16 | type RecordWithEither = 17 | { apple :: Int 18 | , banana :: Either Int String 19 | } 20 | 21 | readEitherImpl 22 | :: forall a b 23 | . JSON.ReadForeign a 24 | => JSON.ReadForeign b 25 | => Foreign 26 | -> Foreign.F (Either a b) 27 | readEitherImpl f 28 | = Left <$> JSON.readImpl f 29 | <|> Right <$> JSON.readImpl f 30 | 31 | readRecordWithEitherJSON :: String -> Either Foreign.MultipleErrors RecordWithEither 32 | readRecordWithEitherJSON s = runExcept do 33 | inter <- JSON.readJSON' s 34 | banana <- readEitherImpl inter.banana 35 | pure $ inter { banana = banana } 36 | 37 | type RecordMisnamedField = 38 | { cherry :: Int 39 | } 40 | 41 | readRecordMisnamedField :: String -> Either Foreign.MultipleErrors RecordMisnamedField 42 | readRecordMisnamedField s = do 43 | inter <- JSON.readJSON s 44 | pure $ Record.rename grapeP cherryP inter 45 | where 46 | grapeP = Proxy :: Proxy "grape" 47 | cherryP = Proxy :: Proxy "cherry" 48 | 49 | main :: Effect Unit 50 | main = do 51 | assert <<< isRight $ readRecordWithEitherJSON """{"apple": 1, "banana": 1}""" 52 | assert <<< isRight $ readRecordWithEitherJSON """{"apple": 1, "banana": "yellow"}""" 53 | -------------------------------------------------------------------------------- /docs/index.rst: -------------------------------------------------------------------------------- 1 | PureScript-Simple-JSON Guide and Docs 2 | ===================================== 3 | 4 | This is a guide for the PureScript library `Simple-JSON `_, which provides an easy way to decode either ``Foreign`` (JS) values or JSON ``String`` values with the most "obvious" representation. This guide will also try to guide you through some of the details of how PureScript the language works, as you may be new to PureScript or not know its characteristics. 5 | 6 | Overall, this library provides you largely automatic ways to get decoding, but does not try to decode any types that do not actually have a JS representation. This means that this library does not provide you with automatic solutions for decoding and encoding Sum or Product types, but there is a section below on how to use Generics in PureScript to achieve the encoding of Sum and Product types that you want. 7 | 8 | .. tip:: If you are coming from Elm, you can think of this library as providing the automatic encoding/decoding of ports, but actually giving you explicit control of the results and allowing you to define encodings as you need. 9 | 10 | .. note:: If there is a topic you would like more help with that is not in this guide, open a issue in the Github repo for it to request it. 11 | 12 | Pages 13 | ================== 14 | 15 | .. toctree:: 16 | 17 | intro 18 | quickstart 19 | inferred-record-types 20 | with-affjax 21 | generics-rep 22 | faq 23 | 24 | .. raw:: html 25 | 26 | 27 | -------------------------------------------------------------------------------- /docs/intro.md: -------------------------------------------------------------------------------- 1 | # Introduction 2 | 3 | ## What is ``Foreign``? 4 | 5 | In PureScript, untyped JS values are typed as ``Foreign`` and are defined in the [Foreign](https://pursuit.purescript.org/packages/purescript-foreign) library. Usually when you define FFI functions, you should define the results of the functions as ``Foreign`` and then decode them to a type if you want to ensure safety in your program. 6 | 7 | For example, this library exposes the method [parseJSON](https://pursuit.purescript.org/packages/purescript-simple-json/4.0.0/docs/Simple.JSON#v:parseJSON) with the type 8 | 9 | ```hs 10 | parseJSON :: String -> F Foreign 11 | ``` 12 | 13 | We'll visit what this ``F`` failure type is later, since you won't need to use it most of the time when you use this library. 14 | 15 | ## How you should use this library 16 | 17 | Generally, you should try to separate your transport types from your domain types such that you never try to tie down the model used in your program to whatever can be represented in JS. For example, a sum type 18 | 19 | ```hs 20 | data IsRegistered 21 | = Registered DateString 22 | | NotRegistered 23 | ``` 24 | 25 | is the correct model to use in your program, while the transport may be defined 26 | 27 | ```hs 28 | type RegistrationStatus = 29 | { registrationDate :: Maybe DateString 30 | } 31 | ``` 32 | 33 | While you `could` use ``Maybe DateString`` all over your application, this type suffers in that there is just not much information for your users to take from this type. If you used a newtype of this, the actual matching usages would still suffer the same problem. 34 | 35 | ## On Sum Types 36 | 37 | Many users complain that Simple-JSON should provide automatic serialization of sum types, but you'll find that preferred encodings for sum types are like opinions -- everyone has one. Instead of giving you a default that wouldn't make sense in the scope of Simple-JSON as providing decoding for JS-representable types, we'll go over how PureScript's Generics-Rep work and how easy it is for you to work with sum types with your preferred methods. 38 | -------------------------------------------------------------------------------- /docs/faq.md: -------------------------------------------------------------------------------- 1 | # FAQ 2 | 3 | ## How do I get instances of ReadForeign/WriteForeign for my newtypes? 4 | 5 | See the post about PureScript newtype deriving here: 6 | 7 | So you can do everything given some definition of a newtype and its instances: 8 | 9 | ```purs 10 | -- from test/Quickstart.purs 11 | 12 | newtype FancyInt = FancyInt Int 13 | 14 | derive newtype instance eqFancyInt :: Eq FancyInt 15 | derive newtype instance showFancyInt :: Show FancyInt 16 | derive newtype instance readForeignFancyInt :: JSON.ReadForeign FancyInt 17 | derive newtype instance writeForeignFancyInt :: JSON.WriteForeign FancyInt 18 | ``` 19 | 20 | ## Why isn't this library Aeson-compatible? 21 | 22 | There are a few factors involved here: 23 | 24 | 1. I (Justin) don't use Aeson instances. 25 | 26 | 2. Many Aeson instances revolve around using Sum and Product types (or Haskell Records, which are not structurally similar to PureScript Records). 27 | 28 | 3. I would rather give you the tools to write your own so that you have instances that match what you are using by having docs/guides like in this page: 29 | 30 | 4. There doesn't seem to be anyone else making a general solution library and publishing it. 31 | 32 | ## I just want some random encoding for my Sum types! 33 | 34 | If you really are sure you don't want to use the existing instances for [Variant](https://pursuit.purescript.org/packages/purescript-variant/5.0.0/docs/Data.Variant#t:Variant) (from [purescript-variant](https://github.com/natefaubion/purescript-variant)), you can use the code from here: 35 | 36 | You might also choose to use this library: 37 | 38 | ## How do I handle keys that aren't lower case? 39 | 40 | PureScript record labels can be quoted. 41 | 42 | ```purs 43 | type MyRecord = 44 | { "Apple" :: String } 45 | 46 | fn :: MyRecord -> String 47 | fn myRecordValue = 48 | myRecordValue."Apple" 49 | ``` 50 | -------------------------------------------------------------------------------- /test/EnumSumGeneric.purs: -------------------------------------------------------------------------------- 1 | module Test.EnumSumGeneric where 2 | 3 | import Prelude 4 | 5 | import Control.Alt ((<|>)) 6 | import Control.Monad.Except (throwError) 7 | import Data.Either (Either, isRight) 8 | import Data.Generic.Rep (class Generic, Constructor(..), NoArguments(..), Sum(..), to) 9 | import Data.Show.Generic (genericShow) 10 | import Effect (Effect) 11 | import Foreign (Foreign) 12 | import Foreign as Foreign 13 | import Simple.JSON as JSON 14 | import Test.Assert (assert) 15 | import Type.Prelude (class IsSymbol, reflectSymbol) 16 | import Type.Proxy (Proxy(..)) 17 | 18 | enumReadForeign :: forall a rep 19 | . Generic a rep 20 | => EnumReadForeign rep 21 | => Foreign 22 | -> Foreign.F a 23 | enumReadForeign f = 24 | to <$> enumReadForeignImpl f 25 | 26 | -- type class for "enums", or nullary sum types 27 | class EnumReadForeign rep where 28 | enumReadForeignImpl :: Foreign -> Foreign.F rep 29 | 30 | instance sumEnumReadForeign :: 31 | ( EnumReadForeign a 32 | , EnumReadForeign b 33 | ) => EnumReadForeign (Sum a b) where 34 | enumReadForeignImpl f 35 | = Inl <$> enumReadForeignImpl f 36 | <|> Inr <$> enumReadForeignImpl f 37 | 38 | instance constructorEnumReadForeign :: 39 | ( IsSymbol name 40 | ) => EnumReadForeign (Constructor name NoArguments) where 41 | enumReadForeignImpl f = do 42 | s <- JSON.readImpl f 43 | if s == name 44 | then pure $ Constructor NoArguments 45 | else throwError <<< pure <<< Foreign.ForeignError $ 46 | "Enum string " <> s <> " did not match expected string " <> name 47 | where 48 | name = reflectSymbol (Proxy :: Proxy name) 49 | 50 | data Fruit 51 | = Abogado 52 | | Boat 53 | | Candy 54 | derive instance genericFruit :: Generic Fruit _ 55 | instance fruitReadForeign :: JSON.ReadForeign Fruit where 56 | readImpl = enumReadForeign 57 | instance furitShow :: Show Fruit where 58 | show = genericShow 59 | 60 | readFruit :: String -> Either Foreign.MultipleErrors Fruit 61 | readFruit = JSON.readJSON 62 | 63 | main :: Effect Unit 64 | main = do 65 | assert <<< isRight $ readFruit "\"Abogado\"" 66 | assert <<< isRight $ readFruit "\"Boat\"" 67 | assert <<< isRight $ readFruit "\"Candy\"" 68 | -------------------------------------------------------------------------------- /test/Generic.purs: -------------------------------------------------------------------------------- 1 | module Test.Generic where 2 | 3 | import Prelude 4 | 5 | import Control.Alt ((<|>)) 6 | import Data.Either (Either, isRight) 7 | import Data.Generic.Rep as GR 8 | import Data.Show.Generic (genericShow) 9 | import Effect (Effect) 10 | import Foreign (Foreign) 11 | import Foreign as Foreign 12 | import Simple.JSON as JSON 13 | import Test.Assert (assert) 14 | 15 | data IntOrBoolean 16 | = Int Int 17 | | Boolean Boolean 18 | instance readForeign :: JSON.ReadForeign IntOrBoolean where 19 | readImpl f 20 | = Int <$> Foreign.readInt f 21 | <|> Boolean <$> Foreign.readBoolean f 22 | instance showIntOrBoolean :: Show IntOrBoolean where 23 | show (Int i) = "(Int " <> show i <> ")" 24 | show (Boolean i) = "(Boolean " <> show i <> ")" 25 | 26 | decodeToIntOrBoolean :: String -> Either Foreign.MultipleErrors IntOrBoolean 27 | decodeToIntOrBoolean = JSON.readJSON 28 | 29 | data IntOrBoolean2 30 | = Int2 Int 31 | | Boolean2 Boolean 32 | 33 | derive instance genericIntOrBoolean2 :: GR.Generic IntOrBoolean2 _ 34 | 35 | instance showIntOrBoolean2 :: Show IntOrBoolean2 where 36 | show = genericShow 37 | instance readForeignIntOrBoolean2 :: JSON.ReadForeign IntOrBoolean2 where 38 | readImpl f = GR.to <$> untaggedSumRep f 39 | 40 | class UntaggedSumRep rep where 41 | untaggedSumRep :: Foreign -> Foreign.F rep 42 | 43 | instance untaggedSumRepSum :: 44 | ( UntaggedSumRep a 45 | , UntaggedSumRep b 46 | ) => UntaggedSumRep (GR.Sum a b) where 47 | untaggedSumRep f 48 | = GR.Inl <$> untaggedSumRep f 49 | <|> GR.Inr <$> untaggedSumRep f 50 | 51 | instance untaggedSumRepConstructor :: 52 | ( UntaggedSumRep a 53 | ) => UntaggedSumRep (GR.Constructor name a) where 54 | untaggedSumRep f = GR.Constructor <$> untaggedSumRep f 55 | 56 | instance untaggedSumRepArgument :: 57 | ( JSON.ReadForeign a 58 | ) => UntaggedSumRep (GR.Argument a) where 59 | untaggedSumRep f = GR.Argument <$> JSON.readImpl f 60 | 61 | decodeToIntOrBoolean2 :: String -> Either Foreign.MultipleErrors IntOrBoolean2 62 | decodeToIntOrBoolean2 = JSON.readJSON 63 | 64 | main :: Effect Unit 65 | main = do 66 | assert <<< isRight $ decodeToIntOrBoolean "1" -- (Right (Int 1)) 67 | assert <<< isRight $ decodeToIntOrBoolean "true" -- (Right (Boolean true)) 68 | assert <<< isRight $ decodeToIntOrBoolean2 "1" -- (Right (Int2 1)) 69 | assert <<< isRight $ decodeToIntOrBoolean2 "true" -- (Right (Boolean2 true)) 70 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # PureScript-Simple-JSON 2 | 3 | ![GitHub Workflow Status (with branch)](https://img.shields.io/github/actions/workflow/status/justinwoo/purescript-simple-json/ci.yml?branch=master&style=flat-square&logo=github) 4 | [documentation status](https://readthedocs.org/projects/purescript-simple-json/badge/?version=latest) 5 | 6 | A simple Foreign/JSON library based on the Purescript's RowToList feature. 7 | 8 | ## Quickstart 9 | 10 | Get going quickly with the Quickstart section of the guide: 11 | 12 | You may also be interested in this presentation about how Simple-JSON works well with PureScript-Record: . Note that the slides are based on an older version of the library and on PureScript 0.11.6, and it is not necessary to understand these slides to get started. 13 | 14 | ## Usage 15 | 16 | In brief: 17 | 18 | ```purs 19 | type MyJSON = 20 | { apple :: String 21 | , banana :: Int 22 | , cherry :: Maybe Boolean 23 | } 24 | 25 | decodeToMyJSON :: String -> Either (NonEmptyList ForeignError) MyJSON 26 | decodeToMyJSON = SimpleJSON.readJSON 27 | ``` 28 | 29 | See the [API Docs](https://pursuit.purescript.org/packages/purescript-simple-json/) or the [tests](test/Main.purs) for usage. 30 | 31 | There is also a guide for how to use this library on [Read the Docs](https://purescript-simple-json.readthedocs.io/en/latest/). 32 | 33 | ## Warning: `Maybe` 34 | 35 | This library will decode `undefined` and `null` as `Nothing` and write `Nothing` as `undefined`. Please use the `Nullable` type if you'd like to read and write `null` instead. Please take caution when using `Maybe` as this default may not be what you want. 36 | 37 | ## FAQ 38 | 39 | ### How do I use this with Affjax? 40 | 41 | Please see this page in the guide: 42 | 43 | ### How do I change how some fields of my JSON objects are read? 44 | 45 | Please see this page in the guide: 46 | 47 | ### How do I work with `data` Types? 48 | 49 | Please see this page in the guide: 50 | 51 | ### Why won't you accept my Pull Request? 52 | 53 | Please read this appeal from another open source author: 54 | 55 | ### How should I actually use this library? 56 | 57 | James Brock has informed me that people still do not understand that this library should be used not as a library. If you do not like any of the behavior in this library or would like to opt out of some behaviors, you should copy this library into your own codebase. Please see that this libraries does not actually contain many lines of code and you should be able to learn how to construct this library from scratch with a few days of reading. 58 | -------------------------------------------------------------------------------- /docs/quickstart.md: -------------------------------------------------------------------------------- 1 | # Quickstart 2 | 3 | ## Decoding / Reading JSON 4 | 5 | Simple-JSON can be used to easily decode from types that have JSON representations, such as numbers, booleans, strings, arrays, and records. 6 | 7 | Let's look at an example using a record alias: 8 | 9 | ```hs 10 | type MyRecordAlias = 11 | { apple :: String 12 | , banana :: Array Int 13 | } 14 | ``` 15 | 16 | Now we can try decoding some JSON: 17 | 18 | ```hs 19 | import Simple.JSON as JSON 20 | 21 | testJSON1 :: String 22 | testJSON1 = """ 23 | { "apple": "Hello" 24 | , "banana": [ 1, 2, 3 ] 25 | } 26 | """ 27 | 28 | main = do 29 | case JSON.readJSON testJSON1 of 30 | Right (r :: MyRecordAlias) -> do 31 | assertEqual { expected: r.apple, actual: "Hello"} 32 | assertEqual { expected: r.banana, actual: [ 1, 2, 3 ] } 33 | Left e -> do 34 | assertEqual { expected: "failed", actual: show e } 35 | ``` 36 | 37 | Since `JSON.readJSON` returns `Either MultipleErrors a`, we need to provide the compiler information on what type the `a` should be. We accomplish this by establishing a concrete type for `a` with the type annotation `r :: MyRecordAlias`, so the return type is now `Either MultipleErrors MyRecordAlias`, which is the same as `Either MultipleErrors { apple :: String, banana :: Array Int }`. 38 | 39 | And that's it! 40 | 41 | ## Encoding / Writing JSON 42 | 43 | Encoding JSON is a failure-proof operation, since we know what we want to encode at compile time. 44 | 45 | ```hs 46 | main = do 47 | let 48 | myValue = 49 | { apple: "Hi" 50 | , banana: [ 1, 2, 3 ] 51 | } :: MyRecordAlias 52 | 53 | log (JSON.writeJSON myValue) -- {"banana":[1,2,3],"apple":"Hi"} 54 | ``` 55 | 56 | And that's all we need to do to encode JSON! 57 | 58 | ## Working with Optional values 59 | 60 | For most cases, the instance for `Maybe` will do what you want by decoding `undefined` and `null` to `Nothing` and writing `undefined` from `Nothing` (meaning that the JSON output will not contain the field). 61 | 62 | ```hs 63 | type WithMaybe = 64 | { cherry :: Maybe Boolean 65 | } 66 | 67 | testJSON3 :: String 68 | testJSON3 = """ 69 | { "cherry": true 70 | } 71 | """ 72 | 73 | testJSON4 :: String 74 | testJSON4 = """ 75 | {} 76 | """ 77 | ``` 78 | 79 | ```hs 80 | main = do 81 | case JSON.readJSON testJSON3 of 82 | Right (r :: WithMaybe) -> do 83 | assertEqual { expected: Just true, actual: r.cherry } 84 | Left e -> do 85 | assertEqual { expected: "failed", actual: show e } 86 | 87 | case JSON.readJSON testJSON4 of 88 | Right (r :: WithMaybe) -> do 89 | assertEqual { expected: Nothing, actual: r.cherry } 90 | Left e -> do 91 | assertEqual { expected: "failed", actual: show e } 92 | 93 | let 94 | withJust = 95 | { cherry: Just true 96 | } :: WithMaybe 97 | withNothing = 98 | { cherry: Nothing 99 | } :: WithMaybe 100 | 101 | log (JSON.writeJSON withJust) -- {"cherry":true} 102 | log (JSON.writeJSON withNothing) -- {} 103 | ``` 104 | 105 | If you explicitly need `null` and not `undefined`, use the `Nullable` type. 106 | 107 | ```hs 108 | main = 109 | case JSON.readJSON testJSON3 of 110 | Right (r :: WithNullable) -> do 111 | assertEqual { expected: toNullable (Just true), actual: r.cherry } 112 | Left e -> do 113 | assertEqual { expected: "failed", actual: show e } 114 | 115 | case JSON.readJSON testJSON4 of 116 | Right (r :: WithNullable) -> do 117 | assertEqual { expected: "failed", actual: show r } 118 | Left e -> do 119 | let errors = Array.fromFoldable e 120 | assertEqual { expected: [ErrorAtProperty "cherry" (TypeMismatch "Nullable Boolean" "Undefined")], actual: errors } 121 | 122 | let 123 | withNullable = 124 | { cherry: toNullable Nothing 125 | } :: WithNullable 126 | log (JSON.writeJSON withNullable) -- {"cherry":null} 127 | ``` 128 | -------------------------------------------------------------------------------- /test/QuickStart.purs: -------------------------------------------------------------------------------- 1 | module Test.Quickstart where 2 | 3 | import Prelude 4 | 5 | import Data.Array as Array 6 | import Data.Either (Either(..)) 7 | import Data.Maybe (Maybe(..)) 8 | import Data.Nullable (Nullable, toNullable) 9 | import Effect (Effect) 10 | import Effect.Class.Console (log) 11 | import Foreign (ForeignError(..)) 12 | import Simple.JSON as JSON 13 | import Test.Assert (assertEqual) 14 | 15 | type MyRecordAlias = 16 | { apple :: String 17 | , banana :: Array Int 18 | } 19 | 20 | testJSON1 :: String 21 | testJSON1 = """ 22 | { "apple": "Hello" 23 | , "banana": [ 1, 2, 3 ] 24 | } 25 | """ 26 | 27 | testJSON2 :: String 28 | testJSON2 = """ 29 | { "apple": false 30 | , "banana": [ 1, 2, 3 ] 31 | } 32 | """ 33 | 34 | type WithMaybe = 35 | { cherry :: Maybe Boolean 36 | } 37 | 38 | testJSON3 :: String 39 | testJSON3 = """ 40 | { "cherry": true 41 | } 42 | """ 43 | 44 | testJSON4 :: String 45 | testJSON4 = """ 46 | {} 47 | """ 48 | 49 | type WithNullable = 50 | { cherry :: Nullable Boolean 51 | } 52 | 53 | newtype FancyInt = FancyInt Int 54 | derive newtype instance eqFancyInt :: Eq FancyInt 55 | derive newtype instance showFancyInt :: Show FancyInt 56 | derive newtype instance readForeignFancyInt :: JSON.ReadForeign FancyInt 57 | derive newtype instance writeForeignFancyInt :: JSON.WriteForeign FancyInt 58 | 59 | main :: Effect Unit 60 | main = do 61 | case JSON.readJSON testJSON1 of 62 | Right (r :: MyRecordAlias) -> do 63 | assertEqual { expected: r.apple, actual: "Hello"} 64 | assertEqual { expected: r.banana, actual: [ 1, 2, 3 ] } 65 | Left e -> do 66 | assertEqual { expected: "failed", actual: show e } 67 | 68 | case JSON.readJSON testJSON2 of 69 | Right (r :: MyRecordAlias) -> do 70 | assertEqual { expected: "failed", actual: show r } 71 | Left e -> do 72 | let errors = Array.fromFoldable e 73 | assertEqual { expected: [ErrorAtProperty "apple" (TypeMismatch "String" "Boolean")], actual: errors } 74 | 75 | let 76 | myValue = 77 | { apple: "Hi" 78 | , banana: [ 1, 2, 3 ] 79 | } :: MyRecordAlias 80 | 81 | log (JSON.writeJSON myValue) -- {"banana":[1,2,3],"apple":"Hi"} 82 | 83 | case JSON.readJSON testJSON3 of 84 | Right (r :: WithMaybe) -> do 85 | assertEqual { expected: Just true, actual: r.cherry } 86 | Left e -> do 87 | assertEqual { expected: "failed", actual: show e } 88 | 89 | case JSON.readJSON testJSON4 of 90 | Right (r :: WithMaybe) -> do 91 | assertEqual { expected: Nothing, actual: r.cherry } 92 | Left e -> do 93 | assertEqual { expected: "failed", actual: show e } 94 | 95 | let 96 | withJust = 97 | { cherry: Just true 98 | } :: WithMaybe 99 | withNothing = 100 | { cherry: Nothing 101 | } :: WithMaybe 102 | 103 | log (JSON.writeJSON withJust) -- {"cherry":true} 104 | log (JSON.writeJSON withNothing) -- {} 105 | 106 | case JSON.readJSON testJSON3 of 107 | Right (r :: WithNullable) -> do 108 | assertEqual { expected: toNullable (Just true), actual: r.cherry } 109 | Left e -> do 110 | assertEqual { expected: "failed", actual: show e } 111 | 112 | case JSON.readJSON testJSON4 of 113 | Right (r :: WithNullable) -> do 114 | assertEqual { expected: "failed", actual: show r } 115 | Left e -> do 116 | let errors = Array.fromFoldable e 117 | assertEqual { expected: [ErrorAtProperty "cherry" (TypeMismatch "Nullable Boolean" "Undefined")], actual: errors } 118 | 119 | let 120 | withNullable = 121 | { cherry: toNullable Nothing 122 | } :: WithNullable 123 | log (JSON.writeJSON withNullable) -- {"cherry":null} 124 | 125 | case JSON.readJSON "1" of 126 | Right fancyInt@(FancyInt i) -> do 127 | assertEqual { expected: FancyInt 1, actual: fancyInt } 128 | assertEqual { expected: 1, actual: i } 129 | Left e -> do 130 | assertEqual { expected: "failed", actual: show e } 131 | -------------------------------------------------------------------------------- /test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Except (runExcept) 6 | import Data.Bifunctor (lmap) 7 | import Data.Either (Either(..), either, isRight) 8 | import Data.List (List(..), (:)) 9 | import Data.List.NonEmpty (NonEmptyList(..)) 10 | import Data.Maybe (Maybe) 11 | import Data.NonEmpty (NonEmpty(..)) 12 | import Data.Nullable (Nullable) 13 | import Data.Variant (Variant) 14 | import Effect (Effect) 15 | import Effect.Exception (throw) 16 | import Foreign (Foreign, ForeignError(..), MultipleErrors) 17 | import Foreign.Object (Object) 18 | import Simple.JSON (class ReadForeign, class WriteForeign, parseJSON, readJSON, writeJSON) 19 | import Test.Assert (assertEqual) 20 | import Test.EnumSumGeneric as Test.EnumSumGeneric 21 | import Test.Generic as Test.Generic 22 | import Test.Inferred as Test.Inferred 23 | import Test.Quickstart as Test.Quickstart 24 | import Type.Proxy (Proxy(..)) 25 | 26 | type E a = Either MultipleErrors a 27 | 28 | type MyTest = 29 | { a :: Int 30 | , b :: String 31 | , c :: Boolean 32 | , d :: Array String 33 | } 34 | 35 | type MyTestNull = 36 | { a :: Int 37 | , b :: String 38 | , c :: Boolean 39 | , d :: Array String 40 | , e :: Maybe (Array String) 41 | } 42 | 43 | type MyTestStrMap = 44 | { a :: Int 45 | , b :: Object Int 46 | } 47 | 48 | type MyTestMaybe = 49 | { a :: Maybe String 50 | } 51 | 52 | type MyTestManyMaybe = 53 | { a :: Maybe String 54 | , aNull :: Maybe String 55 | , b :: Maybe Int 56 | , bNull :: Maybe Int 57 | , c :: Maybe Boolean 58 | , cNull :: Maybe Boolean 59 | , d :: Maybe Number 60 | , dNull :: Maybe Number 61 | , e :: Maybe (Array (Maybe String)) 62 | , eNull :: Maybe (Array (Maybe String)) 63 | } 64 | 65 | type MyTestNullable = 66 | { a :: Nullable String 67 | , b :: Nullable String 68 | } 69 | 70 | type MyTestVariant = Variant 71 | ( a :: String 72 | , b :: Int 73 | ) 74 | 75 | roundtrips :: forall a. ReadForeign a => WriteForeign a => Proxy a -> String -> Effect Unit 76 | roundtrips _ enc0 = do 77 | let parseJSON' = lmap show <<< runExcept <<< parseJSON 78 | dec0 :: E a 79 | dec0 = readJSON enc0 80 | enc1 = either (const "bad1") writeJSON dec0 81 | json0 :: Either String Foreign 82 | json0 = parseJSON' enc0 83 | json1 :: Either String Foreign 84 | json1 = parseJSON' enc1 85 | dec1 :: E a 86 | dec1 = readJSON enc1 87 | enc2 = either (const "bad2") writeJSON dec1 88 | when (enc1 /= enc2) $ throw enc0 89 | 90 | shouldEqual :: forall a . Eq a => Show a => a -> a -> Effect Unit 91 | shouldEqual a b = 92 | assertEqual { actual: a, expected: b} 93 | 94 | main :: Effect Unit 95 | main = do 96 | shouldEqual 1 1 97 | 98 | -- "fails with invalid JSON" 99 | let r1 = readJSON """{ "c": 1, "d": 2}""" 100 | r1 `shouldEqual` 101 | (Left (NonEmptyList (NonEmpty (ErrorAtProperty "a" (TypeMismatch "Int" "Undefined")) ((ErrorAtProperty "b" (TypeMismatch "String" "Undefined")) : (ErrorAtProperty "c" (TypeMismatch "Boolean" "Number")) : (ErrorAtProperty "d" (TypeMismatch "array" "Number")) : Nil)))) 102 | isRight (r1 :: E MyTest) `shouldEqual` false 103 | 104 | -- "works with missing Maybe fields by setting them to Nothing" 105 | let r2 = readJSON "{}" 106 | (writeJSON <$> (r2 :: E MyTestMaybe)) `shouldEqual` (Right """{}""") 107 | 108 | -- "fails with undefined for null with correct error message" 109 | let r3 = readJSON """ 110 | { "a": "asdf" } 111 | """ 112 | r3 `shouldEqual` 113 | (Left (NonEmptyList (NonEmpty (ErrorAtProperty "b" (TypeMismatch "Nullable String" "Undefined")) Nil))) 114 | (isRight (r3 :: E MyTestNullable)) `shouldEqual` false 115 | 116 | -- roundtrips 117 | -- "works with proper JSON" 118 | roundtrips (Proxy :: Proxy MyTest) """ 119 | { "a": 1, "b": "asdf", "c": true, "d": ["A", "B"]} 120 | """ 121 | 122 | -- "works with JSON lacking Maybe field" 123 | roundtrips (Proxy :: Proxy MyTestNull) """ 124 | { "a": 1, "b": "asdf", "c": true, "d": ["A", "B"]} 125 | """ 126 | 127 | -- "works with JSON containing Maybe field" 128 | roundtrips (Proxy :: Proxy MyTestNull) """ 129 | { "a": 1, "b": "asdf", "c": true, "d": ["A", "B"], "e": ["C", "D"]} 130 | """ 131 | 132 | -- -- "works with JSON containing Object field" 133 | roundtrips (Proxy :: Proxy MyTestStrMap) """ 134 | { "a": 1, "b": {"asdf": 1, "c": 2} } 135 | """ 136 | 137 | -- "works with Maybe field and existing value" 138 | roundtrips (Proxy :: Proxy MyTestMaybe) """ 139 | { "a": "foo" } 140 | """ 141 | 142 | -- "works with Nullable" 143 | roundtrips (Proxy :: Proxy MyTestNullable) """ 144 | { "a": null, "b": "a" } 145 | """ 146 | 147 | -- "works with Variant" 148 | roundtrips (Proxy :: Proxy MyTestVariant) """ 149 | { "type": "b", "value": 123 } 150 | """ 151 | 152 | -- run examples 153 | Test.Generic.main 154 | Test.EnumSumGeneric.main 155 | Test.Inferred.main 156 | Test.Quickstart.main 157 | -------------------------------------------------------------------------------- /docs/conf.py: -------------------------------------------------------------------------------- 1 | # -*- coding: utf-8 -*- 2 | # 3 | # Configuration file for the Sphinx documentation builder. 4 | # 5 | # This file does only contain a selection of the most common options. For a 6 | # full list see the documentation: 7 | # http://www.sphinx-doc.org/en/master/config 8 | 9 | # -- Path setup -------------------------------------------------------------- 10 | 11 | # If extensions (or modules to document with autodoc) are in another directory, 12 | # add these directories to sys.path here. If the directory is relative to the 13 | # documentation root, use os.path.abspath to make it absolute, like shown here. 14 | # 15 | # import os 16 | # import sys 17 | # sys.path.insert(0, os.path.abspath('.')) 18 | 19 | 20 | # -- Project information ----------------------------------------------------- 21 | 22 | project = u'PureScript-Simple-JSON' 23 | copyright = u'2018, Justin Woo' 24 | author = u'Justin Woo' 25 | 26 | # The short X.Y version 27 | version = u'' 28 | # The full version, including alpha/beta/rc tags 29 | release = u'' 30 | 31 | 32 | # -- General configuration --------------------------------------------------- 33 | 34 | # If your documentation needs a minimal Sphinx version, state it here. 35 | # 36 | # needs_sphinx = '1.0' 37 | 38 | # Add any Sphinx extension module names here, as strings. They can be 39 | # extensions coming with Sphinx (named 'sphinx.ext.*') or your custom 40 | # ones. 41 | extensions = [ 42 | ] 43 | 44 | # Add any paths that contain templates here, relative to this directory. 45 | templates_path = ['_templates'] 46 | 47 | source_parsers = { 48 | '.md': 'recommonmark.parser.CommonMarkParser', 49 | } 50 | 51 | # The suffix(es) of source filenames. 52 | # You can specify multiple suffix as a list of string: 53 | # 54 | source_suffix = ['.rst', '.md'] 55 | 56 | # The master toctree document. 57 | master_doc = 'index' 58 | 59 | # The language for content autogenerated by Sphinx. Refer to documentation 60 | # for a list of supported languages. 61 | # 62 | # This is also used if you do content translation via gettext catalogs. 63 | # Usually you set "language" from the command line for these cases. 64 | language = None 65 | 66 | # List of patterns, relative to source directory, that match files and 67 | # directories to ignore when looking for source files. 68 | # This pattern also affects html_static_path and html_extra_path . 69 | exclude_patterns = [u'_build', 'Thumbs.db', '.DS_Store'] 70 | 71 | # The name of the Pygments (syntax highlighting) style to use. 72 | pygments_style = 'default' 73 | 74 | 75 | # -- Options for HTML output ------------------------------------------------- 76 | 77 | # The theme to use for HTML and HTML Help pages. See the documentation for 78 | # a list of builtin themes. 79 | # 80 | html_theme = 'sphinx_rtd_theme' 81 | 82 | # Theme options are theme-specific and customize the look and feel of a theme 83 | # further. For a list of options available for each theme, see the 84 | # documentation. 85 | # 86 | # html_theme_options = {} 87 | 88 | # Add any paths that contain custom static files (such as style sheets) here, 89 | # relative to this directory. They are copied after the builtin static files, 90 | # so a file named "default.css" will overwrite the builtin "default.css". 91 | html_static_path = ['_static'] 92 | 93 | # Custom sidebar templates, must be a dictionary that maps document names 94 | # to template names. 95 | # 96 | # The default sidebars (for documents that don't match any pattern) are 97 | # defined by theme itself. Builtin themes are using these templates by 98 | # default: ``['localtoc.html', 'relations.html', 'sourcelink.html', 99 | # 'searchbox.html']``. 100 | # 101 | # html_sidebars = {} 102 | 103 | 104 | # -- Options for HTMLHelp output --------------------------------------------- 105 | 106 | # Output file base name for HTML help builder. 107 | htmlhelp_basename = 'PureScript-Simple-JSONdoc' 108 | 109 | 110 | # -- Options for LaTeX output ------------------------------------------------ 111 | 112 | latex_elements = { 113 | # The paper size ('letterpaper' or 'a4paper'). 114 | # 115 | # 'papersize': 'letterpaper', 116 | 117 | # The font size ('10pt', '11pt' or '12pt'). 118 | # 119 | # 'pointsize': '10pt', 120 | 121 | # Additional stuff for the LaTeX preamble. 122 | # 123 | # 'preamble': '', 124 | 125 | # Latex figure (float) alignment 126 | # 127 | # 'figure_align': 'htbp', 128 | } 129 | 130 | # Grouping the document tree into LaTeX files. List of tuples 131 | # (source start file, target name, title, 132 | # author, documentclass [howto, manual, or own class]). 133 | latex_documents = [ 134 | (master_doc, 'PureScript-Simple-JSON.tex', u'PureScript-Simple-JSON Documentation', 135 | u'Justin Woo', 'manual'), 136 | ] 137 | 138 | 139 | # -- Options for manual page output ------------------------------------------ 140 | 141 | # One entry per manual page. List of tuples 142 | # (source start file, name, description, authors, manual section). 143 | man_pages = [ 144 | (master_doc, 'purescript-simple-json', u'PureScript-Simple-JSON Documentation', 145 | [author], 1) 146 | ] 147 | 148 | 149 | # -- Options for Texinfo output ---------------------------------------------- 150 | 151 | # Grouping the document tree into Texinfo files. List of tuples 152 | # (source start file, target name, title, author, 153 | # dir menu entry, description, category) 154 | texinfo_documents = [ 155 | (master_doc, 'PureScript-Simple-JSON', u'PureScript-Simple-JSON Documentation', 156 | author, 'PureScript-Simple-JSON', 'One line description of project.', 157 | 'Miscellaneous'), 158 | ] 159 | 160 | def setup(app): 161 | app.add_stylesheet('css/default.css') 162 | -------------------------------------------------------------------------------- /docs/inferred-record-types.md: -------------------------------------------------------------------------------- 1 | # Working with Inferred Record Types 2 | 3 | ## How records work in PureScript 4 | 5 | In PureScript, a `Record` type is parameterized by `# Type` 6 | 7 | ```hs 8 | data Record :: # Type -> Type 9 | ``` 10 | 11 | As seen on [Pursuit](https://pursuit.purescript.org/builtins/docs/Prim#t:Record), this means that records are an application of row types of `Type`, such that the two definitions are equivalent: 12 | 13 | ```hs 14 | type Person = { name :: String, age :: Number } 15 | 16 | type Person = Record ( name :: String, age :: Number ) 17 | ``` 18 | 19 | With this knowledge, we can work with records in a generic way where any operation with the correct row type constraints is valid. 20 | 21 | This is unlike other languages where records are often simply product types with selector information. Let's look at some examples of this at work. 22 | 23 | ## Modifying a field's type 24 | 25 | Say that we wanted to read in JSON into this type: 26 | 27 | ```hs 28 | type RecordWithEither = 29 | { apple :: Int 30 | , banana :: Either Int String 31 | } 32 | ``` 33 | 34 | We know that there's no representation of this `Either Int String` in JavaScript, but it would be convenient to read some value into it. First, let's define a function to read in any `Either`: 35 | 36 | ```hs 37 | readEitherImpl 38 | :: forall a b 39 | . JSON.ReadForeign a 40 | => JSON.ReadForeign b 41 | => Foreign 42 | -> Foreign.F (Either a b) 43 | readEitherImpl f 44 | = Left <$> JSON.readImpl f 45 | <|> Right <$> JSON.readImpl f 46 | ``` 47 | 48 | Now we can read in to an `Either` any `a` and `b` that have instances for `ReadForeign`. We can then use this to modify a field in an inferred context: 49 | 50 | ```hs 51 | readRecordWithEitherJSON :: String -> Either Foreign.MultipleErrors RecordWithEither 52 | readRecordWithEitherJSON s = runExcept do 53 | inter <- JSON.readJSON' s 54 | banana <- readEitherImpl inter.banana 55 | pure $ inter { banana = banana } 56 | ``` 57 | 58 | So what goes on here is that since the result of the function is our `RecordWithEither` with a field of `banana :: Either Int String`, the type is inferred "going backwards", so with the application of our function that is now concretely typed in this context as `readEitherImpl :: Foreign -> Foreign.F (Either Int String)`, the `inter` is read in as `{ apple :: Int, banana :: Foreign }`. 59 | 60 | In this case, we used record update syntax to modify our inferred record, but we also could have done this generically using `Record.modify` from the [Record](https://pursuit.purescript.org/packages/purescript-record) library. 61 | 62 | ## PureScript-Record in a nutshell 63 | 64 | Most of PureScript-Record revolves around usages of two row type classes from [Prim.Row](https://justinwoo.github.io/generated-docs-12/generated-docs/Prim.Row.html): 65 | 66 | ```hs 67 | class Cons 68 | (label :: Symbol) (a :: Type) (tail :: # Type) (row :: # Type) 69 | | label a tail -> row, label row -> a tail 70 | 71 | class Lacks 72 | (label :: Symbol) (row :: # Type) 73 | ``` 74 | 75 | `class Cons` is a relation of a field of a given `Symbol` label (think type-level `String`), its value `Type`, a row type `tail`, and a row type `row` which is made of the `tail` and the field put together. This is very much like your normal `List` of `Cons a` and `Nil`, but with the unordered row type structure at the type level (that `(a :: String, b :: Int)` is equivalent to `(b :: Int, a :: String)`). 76 | 77 | `class Lacks` is a relation of a given `Symbol` label not existing in any of the fields of `row`. 78 | 79 | With this bit of knowledge, we can go ahead and look at the docs of the [Record](https://pursuit.purescript.org/packages/purescript-record) library. 80 | 81 | Let's go through a few of these. First, `get`: 82 | 83 | ```hs 84 | get 85 | :: forall r r' l a 86 | . IsSymbol l 87 | => Cons l a r' r 88 | => SProxy l 89 | -> { | r } 90 | -> a 91 | ``` 92 | 93 | So here right away we can see that the `Cons` constraint is used to declare that the label `l` provided by the `SProxy` argument must exist in the row type `r`, and that there exists a `r'`, a complementary row type, which is `r` but without the field `l, a`. With this, this function is able to get out the value of type `a` at label `l`. This function doesn't know what concrete label is going to be used, but it uses this constraint to ensure that the field exists in the record. 94 | 95 | ```hs 96 | insert 97 | :: forall r1 r2 l a 98 | . IsSymbol l 99 | => Lacks l r1 100 | => Cons l a r1 r2 101 | => SProxy l 102 | -> a 103 | -> { | r1 } 104 | -> { | r2 } 105 | ``` 106 | 107 | With `insert`, we work with the input row type `r1` and the output row type `r2`. The constraints here work that the `r1` row should not contain a field with label `l`, and that the result of adding a field of `l, a` to `r1` yields `r2`. 108 | 109 | Now, the most involved example: 110 | 111 | ```hs 112 | rename 113 | :: forall prev next ty input inter output 114 | . IsSymbol prev 115 | => IsSymbol next 116 | => Cons prev ty inter input 117 | => Lacks prev inter 118 | => Cons next ty inter output 119 | => Lacks next inter 120 | => SProxy prev 121 | -> SProxy next 122 | -> { | input } 123 | -> { | output } 124 | ``` 125 | 126 | Because PureScript does not solve multiple constraints simultaneously, we work with three row types here: `input`, `inter` (intermediate), and `output`. This function takes two `Symbol` types: one for the current label of the field and one for the next label. Then the constraints work such that `inter` is `input` without the field `prev, ty` and lacks any additional fields of `prev`, as row types can have duplicate labels as they are not only for records. Then `output` is constructured by adding the field `next, ty` to `inter` and checking that the `inter` does not already contain a field with the label `next`. While this seems complicated at first, slowly reading through the constraints will show that this is a series of piecewise operations instead of being a multiple-constraint system. 127 | 128 | ## Application of generic Record functions 129 | 130 | Say we have a type where we know the JSON will have the wrong name: 131 | 132 | ```hs 133 | type RecordMisnamedField = 134 | { cherry :: Int 135 | } 136 | ``` 137 | 138 | If the JSON we receive has this field but with the name "grape", what should we do? 139 | 140 | We can apply the same inferred record type method as above but with `Record.rename`: 141 | 142 | ```hs 143 | readRecordMisnamedField :: String -> Either Foreign.MultipleErrors RecordMisnamedField 144 | readRecordMisnamedField s = do 145 | inter <- JSON.readJSON s 146 | pure $ Record.rename grapeP cherryP inter 147 | where 148 | grapeP = SProxy :: SProxy "grape" 149 | cherryP = SProxy :: SProxy "cherry" 150 | ``` 151 | 152 | So again, by applying a function that renames `grape, Int` to `cherry, Int`, the inferred record type of the `inter` is `{ grape :: Int }` and that is the type used to decode the JSON. 153 | 154 | Hopefully this page has shown you how powerful row type based Records are in PureScript and the generic operations they allow. 155 | 156 | *You might be interested in reading through [slides](https://speakerdeck.com/justinwoo/easy-json-deserialization-with-simple-json-and-record) for further illustrations of how generic record operations work and how they can be used with Simple-JSON.* 157 | -------------------------------------------------------------------------------- /docs/generics-rep.md: -------------------------------------------------------------------------------- 1 | # Usage with Generics-Rep 2 | 3 | ## Motivation 4 | 5 | If you really want to work with sum types using Simple-JSON, you will have to define instances for your types accordingly. Normally, this would mean that you would have to define a bunch of instances manually. For example, 6 | 7 | ```hs 8 | data IntOrBoolean 9 | = Int Int 10 | | Boolean Boolean 11 | 12 | instance readForeign :: JSON.ReadForeign IntOrBoolean where 13 | readImpl f 14 | = Int <$> Foreign.readInt f 15 | <|> Boolean <$> Foreign.readBoolean f 16 | ``` 17 | 18 | But this ends up with us needing to maintain a mountain of error-prone boilerplate, where we might forget to include a constructor or accidentally have duplicate cases. We should be able to work more generically to write how instances should be created once, and then have all of these instances created for us for free. 19 | 20 | This is the idea of using datatype generics, which are provided by the [Generics-Rep](https://pursuit.purescript.org/packages/purescript-generics-rep) library in PureScript. 21 | 22 | ## Generics-Rep in short 23 | 24 | Since what makes Generics-Rep work is in the PureScript compiler as a built-in derivation, you can read through its source to get the gist of it: [Link](https://github.com/purescript/purescript-generics-rep/blob/49ba119b315ff782293e6f59625d6b5e87099812/src/Data/Generic/Rep.purs) 25 | 26 | So once you've skimmed through that, let's first look at `class Generic`: 27 | 28 | ```hs 29 | class Generic a rep | a -> rep where 30 | to :: rep -> a 31 | from :: a -> rep 32 | ``` 33 | 34 | The functional dependencies here declare that instances of `Generic` are determined by the type given, so only `a` needs to be known to get `rep`. Then we have a method for turning the representation into our type with `to` and our type into a representation with `from`. This means that if we define a function that can produce a `F rep` from decoding `Foreign` in our `JSON.ReadForeign` instances, we can map the `to` function to it to get `F a`. We'll see how that works later. 35 | 36 | *If some of this isn't familiar to you, you should read about type classes from some source like [PureScript By Example](https://leanpub.com/purescript/read#leanpub-auto-type-classes)* 37 | 38 | Then, let's look at some of the most relevant representation types: 39 | 40 | ```hs 41 | -- | A representation for types with multiple constructors. 42 | data Sum a b = Inl a | Inr b 43 | 44 | -- | A representation for constructors which includes the data constructor name 45 | -- | as a type-level string. 46 | newtype Constructor (name :: Symbol) a = Constructor a 47 | 48 | -- | A representation for an argument in a data constructor. 49 | newtype Argument a = Argument a 50 | ``` 51 | 52 | These will be the main types that will need to write instances for when we define a type class to do some generic decoding. These correspond to the following parts of a definition: 53 | 54 | ```hs 55 | data Things = Apple Int | Banana String 56 | -- a Sum b 57 | -- e.g. Sum (Inl a) (Inr b) 58 | 59 | data Things = Apple Int | Banana String 60 | -- Constructor(name) a 61 | -- e.g. Constructor "Apple" a 62 | 63 | data Things = Apple Int | Banana String 64 | -- Argument(a) 65 | -- e.g. Argument Int 66 | ``` 67 | 68 | This diagram probably won't be that useful the first time you read it, but you may find it to be nice to return to. 69 | 70 | *You can read more coherent explanations like in the documentation for GHC Generics in [generics-deriving](http://hackage.haskell.org/package/generic-deriving-1.12.1/docs/Generics-Deriving-Base.html)* 71 | 72 | ## Applying Generics-Rep to decoding untagged JSON values 73 | 74 | Let's revisit the `IntOrBoolean` example, but this time by using Generics-Rep. 75 | 76 | ```hs 77 | import Data.Generic.Rep as GR 78 | import Data.Generic.Rep.Show (genericShow) 79 | 80 | data IntOrBoolean2 81 | = Int2 Int 82 | | Boolean2 Boolean 83 | 84 | -- note the underscore at the end for the `rep` parameter of class Generic 85 | derive instance genericIntOrBoolean2 :: GR.Generic IntOrBoolean2 _ 86 | 87 | instance showIntOrBoolean2 :: Show IntOrBoolean2 where 88 | show = genericShow 89 | -- now we get a Show based on Generic 90 | 91 | instance readForeignIntOrBoolean2 :: JSON.ReadForeign IntOrBoolean2 where 92 | readImpl f = GR.to <$> untaggedSumRep f 93 | -- as noted above, mapping to so that we go from F rep to F IntOrBoolean 94 | 95 | class UntaggedSumRep rep where 96 | untaggedSumRep :: Foreign -> Foreign.F rep 97 | ``` 98 | 99 | So with our class `UntaggedSumRep`, we have our method `untaggedSumRep` for decoding `Foreign` to `rep`. 100 | 101 | Once we have this code, we'll get some errors about missing instances for `Sum`, `Constructor`, and `Argument` as expected. 102 | 103 | First, we define our `Sum` instance so we take the alternative of a `Inl` construction and `Inr` construction: 104 | 105 | ```hs 106 | instance untaggedSumRepSum :: 107 | ( UntaggedSumRep a 108 | , UntaggedSumRep b 109 | ) => UntaggedSumRep (GR.Sum a b) where 110 | untaggedSumRep f 111 | = GR.Inl <$> untaggedSumRep f 112 | <|> GR.Inr <$> untaggedSumRep f 113 | ``` 114 | 115 | And in our instance we have clearly constrained `a` and `b` for having instances of `UntaggedSumRep`, so that we can use `untaggedSumRep` on the members. 116 | 117 | Then we define our `Constructor` instance: 118 | 119 | ```hs 120 | instance untaggedSumRepConstructor :: 121 | ( UntaggedSumRep a 122 | ) => UntaggedSumRep (GR.Constructor name a) where 123 | untaggedSumRep f = GR.Constructor <$> untaggedSumRep f 124 | ``` 125 | 126 | This definition similar to above, but just with our single constructor case. 127 | 128 | *This is where you would try reading `f` into a record by doing something like `record :: { tag :: String, value :: Foreign } <- f` in a do block, if you wanted to represent sum types in that way. Sky's the limit!* 129 | 130 | Then let's define the argument instance that will call `readImpl` on the `Foreign` value. 131 | 132 | ```hs 133 | instance untaggedSumRepArgument :: 134 | ( JSON.ReadForeign a 135 | ) => UntaggedSumRep (GR.Argument a) where 136 | untaggedSumRep f = GR.Argument <$> JSON.readImpl f 137 | ``` 138 | 139 | And so at this level, we try to decode the `Foreign` value directly to the type of the argument. 140 | 141 | With just these few lines of code, we now have generic decoding for our untagged sum type encoding that we can apply to any sum type where `Generic` is derived and the generic representation contains `Sum`, `Constructor`, and `Argument`. To get started with your own instances, check out the example in [test/Generic.purs](https://github.com/justinwoo/purescript-simple-json/blob/master/test/Generic.purs) in the Simple-JSON repo. 142 | 143 | ## Working with "Enum" sum types 144 | 145 | If you have sum types where all of the constructors are nullary, you may want to work with them as string literals. For example: 146 | 147 | ```hs 148 | data Fruit 149 | = Abogado 150 | | Boat 151 | | Candy 152 | derive instance genericFruit :: Generic Fruit _ 153 | ``` 154 | 155 | Like the above, we should write a function that can work with the generic representation of sum types, so that we can apply this to all enum-like sum types that derive `Generic` and use it like so: 156 | 157 | ```hs 158 | instance fruitReadForeign :: JSON.ReadForeign Fruit where 159 | readImpl = enumReadForeign 160 | 161 | enumReadForeign :: forall a rep 162 | . Generic a rep 163 | => EnumReadForeign rep 164 | => Foreign 165 | -> Foreign.F a 166 | enumReadForeign f = 167 | to <$> enumReadForeignImpl f 168 | ``` 169 | 170 | First, we define our class which is take the rep and return a `Foreign.F rep`: 171 | 172 | ```hs 173 | class EnumReadForeign rep where 174 | enumReadForeignImpl :: Foreign -> Foreign.F rep 175 | ``` 176 | 177 | Then we only need two instance for this class. First, the instance for the `Sum` type to split cases: 178 | 179 | ```hs 180 | instance sumEnumReadForeign :: 181 | ( EnumReadForeign a 182 | , EnumReadForeign b 183 | ) => EnumReadForeign (Sum a b) where 184 | enumReadForeignImpl f 185 | = Inl <$> enumReadForeignImpl f 186 | <|> Inr <$> enumReadForeignImpl f 187 | ``` 188 | 189 | Then we need to match on `Constructor`, but only when its second argument is `NoArguments`, as we want only to work with enum sum types. 190 | 191 | ```hs 192 | instance constructorEnumReadForeign :: 193 | ( IsSymbol name 194 | ) => EnumReadForeign (Constructor name NoArguments) where 195 | enumReadForeignImpl f = do 196 | s <- JSON.readImpl f 197 | if s == name 198 | then pure $ Constructor NoArguments 199 | else throwError <<< pure <<< Foreign.ForeignError $ 200 | "Enum string " <> s <> " did not match expected string " <> name 201 | where 202 | name = reflectSymbol (SProxy :: SProxy name) 203 | ``` 204 | 205 | We put a `IsSymbol` constraint on `name` so that can reflect it to a string and check if it is equal to the string that is taken from the foreign value. In the success branch, we construct the `Constructor` value with the `NoArguments` value. 206 | 207 | With just this, we can now decode all enum-like sums: 208 | 209 | ```hs 210 | readFruit :: String -> Either Foreign.MultipleErrors Fruit 211 | readFruit = JSON.readJSON 212 | 213 | main = do 214 | logShow $ readFruit "\"Abogado\"" 215 | logShow $ readFruit "\"Boat\"" 216 | logShow $ readFruit "\"Candy\"" 217 | ``` 218 | -------------------------------------------------------------------------------- /src/Simple/JSON.purs: -------------------------------------------------------------------------------- 1 | module Simple.JSON 2 | ( E 3 | , readJSON 4 | , readJSON' 5 | , readJSON_ 6 | , writeJSON 7 | , write 8 | , read 9 | , read' 10 | , read_ 11 | , readAsForeign 12 | , parseJSON 13 | , undefined 14 | , unsafeStringify 15 | 16 | , class ReadForeign 17 | , readImpl 18 | , class ReadForeignFields 19 | , getFields 20 | , class ReadForeignVariant 21 | , readVariantImpl 22 | 23 | , class WriteForeign 24 | , writeImpl 25 | , class WriteForeignFields 26 | , writeImplFields 27 | , class WriteForeignVariant 28 | , writeVariantImpl 29 | 30 | ) where 31 | 32 | import Prelude 33 | 34 | import Control.Alt ((<|>)) 35 | import Control.Monad.Except (ExceptT(..), except, runExcept, runExceptT, withExcept) 36 | import Data.Array.NonEmpty (NonEmptyArray, fromArray, toArray) 37 | import Data.Bifunctor (lmap) 38 | import Data.Either (Either(..), hush, note) 39 | import Data.Identity (Identity(..)) 40 | import Data.List.NonEmpty (singleton) 41 | import Data.Maybe (Maybe(..), maybe) 42 | import Data.Nullable (Nullable, toMaybe, toNullable) 43 | import Data.Symbol (class IsSymbol, reflectSymbol) 44 | import Data.Traversable (sequence, traverse) 45 | import Data.TraversableWithIndex (traverseWithIndex) 46 | import Data.Variant (Variant, inj, on) 47 | import Effect.Exception (message, try) 48 | import Effect.Uncurried as EU 49 | import Effect.Unsafe (unsafePerformEffect) 50 | import Foreign (F, Foreign, ForeignError(..), MultipleErrors, fail, isNull, isUndefined, readArray, readBoolean, readChar, readInt, readNull, readNumber, readString, tagOf, unsafeFromForeign, unsafeToForeign) 51 | import Foreign.Index (readProp) 52 | import Foreign.Object (Object) 53 | import Foreign.Object as Object 54 | import Partial.Unsafe (unsafeCrashWith) 55 | import Prim.Row as Row 56 | import Prim.RowList (class RowToList, Cons, Nil, RowList) 57 | import Record (get) 58 | import Record.Builder (Builder) 59 | import Record.Builder as Builder 60 | import Type.Proxy (Proxy(..)) 61 | 62 | -- | An alias for the Either result of decoding 63 | type E a = Either MultipleErrors a 64 | 65 | -- | Read a JSON string to a type `a` while returning a `MultipleErrors` if the 66 | -- | parsing failed. 67 | readJSON :: forall a 68 | . ReadForeign a 69 | => String 70 | -> E a 71 | readJSON = runExcept <<< (readImpl <=< parseJSON) 72 | 73 | -- | Read a JSON string to a type `a` using `F a`. Useful with record types. 74 | readJSON' :: forall a 75 | . ReadForeign a 76 | => String 77 | -> F a 78 | readJSON' = readImpl <=< parseJSON 79 | 80 | -- | Read a JSON string to a type `a` while returning `Nothing` if the parsing 81 | -- | failed. 82 | readJSON_ :: forall a 83 | . ReadForeign a 84 | => String 85 | -> Maybe a 86 | readJSON_ = hush <<< readJSON 87 | 88 | -- | JSON.stringify 89 | foreign import _unsafeStringify :: forall a. a -> String 90 | 91 | unsafeStringify :: forall a. a -> String 92 | unsafeStringify = _unsafeStringify 93 | 94 | -- | Write a JSON string from a type `a`. 95 | writeJSON :: forall a 96 | . WriteForeign a 97 | => a 98 | -> String 99 | writeJSON = _unsafeStringify <<< writeImpl 100 | 101 | write :: forall a 102 | . WriteForeign a 103 | => a 104 | -> Foreign 105 | write = writeImpl 106 | 107 | -- | Read a Foreign value to a type 108 | read :: forall a 109 | . ReadForeign a 110 | => Foreign 111 | -> E a 112 | read = runExcept <<< readImpl 113 | 114 | -- | Read a value of any type as Foreign to a type 115 | readAsForeign :: forall a b 116 | . ReadForeign a 117 | => b 118 | -> E a 119 | readAsForeign = read <<< unsafeToForeign 120 | 121 | read' :: forall a 122 | . ReadForeign a 123 | => Foreign 124 | -> F a 125 | read' = readImpl 126 | 127 | -- | Read a Foreign value to a type, as a Maybe of type 128 | read_ :: forall a 129 | . ReadForeign a 130 | => Foreign 131 | -> Maybe a 132 | read_ = hush <<< read 133 | 134 | foreign import _parseJSON :: EU.EffectFn1 String Foreign 135 | 136 | parseJSON :: String -> F Foreign 137 | parseJSON 138 | = ExceptT 139 | <<< Identity 140 | <<< lmap (pure <<< ForeignError <<< message) 141 | <<< runPure 142 | <<< try 143 | <<< EU.runEffectFn1 _parseJSON 144 | where 145 | -- Nate Faubion: "It uses unsafePerformEffect because that’s the only way to catch exceptions and still use the builtin json decoder" 146 | runPure = unsafePerformEffect 147 | 148 | foreign import _undefined :: Foreign 149 | 150 | undefined :: Foreign 151 | undefined = _undefined 152 | 153 | -- | A class for reading foreign values to a type 154 | class ReadForeign a where 155 | readImpl :: Foreign -> F a 156 | 157 | instance readForeign :: ReadForeign Foreign where 158 | readImpl = pure 159 | 160 | instance readChar :: ReadForeign Char where 161 | readImpl = readChar 162 | 163 | instance readNumber :: ReadForeign Number where 164 | readImpl = readNumber 165 | 166 | instance readInt :: ReadForeign Int where 167 | readImpl = readInt 168 | 169 | instance readString :: ReadForeign String where 170 | readImpl = readString 171 | 172 | instance readBoolean :: ReadForeign Boolean where 173 | readImpl = readBoolean 174 | 175 | instance readArray :: ReadForeign a => ReadForeign (Array a) where 176 | readImpl = traverseWithIndex readAtIdx <=< readArray 177 | where 178 | readAtIdx i f = withExcept (map (ErrorAtIndex i)) (readImpl f) 179 | 180 | instance readMaybe :: ReadForeign a => ReadForeign (Maybe a) where 181 | readImpl = readNullOrUndefined readImpl 182 | where 183 | readNullOrUndefined _ value | isNull value || isUndefined value = pure Nothing 184 | readNullOrUndefined f value = Just <$> f value 185 | 186 | instance readNullable :: ReadForeign a => ReadForeign (Nullable a) where 187 | readImpl o = withExcept (map reformat) $ 188 | map toNullable <$> traverse readImpl =<< readNull o 189 | where 190 | reformat error = case error of 191 | TypeMismatch inner other -> TypeMismatch ("Nullable " <> inner) other 192 | _ -> error 193 | 194 | instance readObject :: ReadForeign a => ReadForeign (Object.Object a) where 195 | readImpl = sequence <<< Object.mapWithKey (const readImpl) <=< readObject' 196 | where 197 | readObject' :: Foreign -> F (Object Foreign) 198 | readObject' value 199 | | tagOf value == "Object" = pure $ unsafeFromForeign value 200 | | otherwise = fail $ TypeMismatch "Object" (tagOf value) 201 | 202 | 203 | instance readRecord :: 204 | ( RowToList fields fieldList 205 | , ReadForeignFields fieldList () fields 206 | ) => ReadForeign (Record fields) where 207 | readImpl o = flip Builder.build {} <$> getFields fieldListP o 208 | where 209 | fieldListP = Proxy :: Proxy fieldList 210 | 211 | -- | A class for reading foreign values from properties 212 | class ReadForeignFields (xs :: RowList Type) (from :: Row Type) (to :: Row Type) 213 | | xs -> from to where 214 | getFields :: Proxy xs 215 | -> Foreign 216 | -> F (Builder (Record from) (Record to)) 217 | 218 | instance readFieldsCons :: 219 | ( IsSymbol name 220 | , ReadForeign ty 221 | , ReadForeignFields tail from from' 222 | , Row.Lacks name from' 223 | , Row.Cons name ty from' to 224 | ) => ReadForeignFields (Cons name ty tail) from to where 225 | getFields _ obj = (compose <$> first) `exceptTApply` rest 226 | where 227 | first = do 228 | value <- withExcept' (readImpl =<< readProp name obj) 229 | pure $ Builder.insert nameP value 230 | rest = getFields tailP obj 231 | nameP = Proxy :: Proxy name 232 | tailP = Proxy :: Proxy tail 233 | name = reflectSymbol nameP 234 | withExcept' = withExcept <<< map $ ErrorAtProperty name 235 | 236 | exceptTApply :: forall a b e m. Semigroup e => Applicative m => ExceptT e m (a -> b) -> ExceptT e m a -> ExceptT e m b 237 | exceptTApply fun a = ExceptT $ applyEither 238 | <$> runExceptT fun 239 | <*> runExceptT a 240 | 241 | applyEither :: forall e a b. Semigroup e => Either e (a -> b) -> Either e a -> Either e b 242 | applyEither (Left e) (Right _) = Left e 243 | applyEither (Left e1) (Left e2) = Left (e1 <> e2) 244 | applyEither (Right _) (Left e) = Left e 245 | applyEither (Right fun) (Right a) = Right (fun a) 246 | 247 | instance readFieldsNil :: 248 | ReadForeignFields Nil () () where 249 | getFields _ _ = 250 | pure identity 251 | 252 | instance readForeignVariant :: 253 | ( RowToList variants rl 254 | , ReadForeignVariant rl variants 255 | ) => ReadForeign (Variant variants) where 256 | readImpl o = readVariantImpl (Proxy :: Proxy rl) o 257 | 258 | class ReadForeignVariant (xs :: RowList Type) (row :: Row Type) 259 | | xs -> row where 260 | readVariantImpl :: Proxy xs 261 | -> Foreign 262 | -> F (Variant row) 263 | 264 | instance readVariantNil :: 265 | ReadForeignVariant Nil trash where 266 | readVariantImpl _ _ = fail $ ForeignError "Unable to match any variant member." 267 | 268 | instance readVariantCons :: 269 | ( IsSymbol name 270 | , ReadForeign ty 271 | , Row.Cons name ty trash row 272 | , ReadForeignVariant tail row 273 | ) => ReadForeignVariant (Cons name ty tail) row where 274 | readVariantImpl _ o = do 275 | obj :: { type :: String, value :: Foreign } <- readImpl o 276 | if obj.type == name 277 | then do 278 | value :: ty <- readImpl obj.value 279 | pure $ inj namep value 280 | else 281 | (fail <<< ForeignError $ "Did not match variant tag " <> name) 282 | <|> readVariantImpl (Proxy :: Proxy tail) o 283 | where 284 | namep = Proxy :: Proxy name 285 | name = reflectSymbol namep 286 | 287 | -- -- | A class for writing a value into JSON 288 | -- -- | need to do this intelligently using Foreign probably, because of null and undefined whatever 289 | class WriteForeign a where 290 | writeImpl :: a -> Foreign 291 | 292 | instance writeForeignForeign :: WriteForeign Foreign where 293 | writeImpl = identity 294 | 295 | instance writeForeignString :: WriteForeign String where 296 | writeImpl = unsafeToForeign 297 | 298 | instance writeForeignInt :: WriteForeign Int where 299 | writeImpl = unsafeToForeign 300 | 301 | instance writeForeignChar :: WriteForeign Char where 302 | writeImpl = unsafeToForeign 303 | 304 | instance writeForeignNumber :: WriteForeign Number where 305 | writeImpl = unsafeToForeign 306 | 307 | instance writeForeignBoolean :: WriteForeign Boolean where 308 | writeImpl = unsafeToForeign 309 | 310 | instance writeForeignArray :: WriteForeign a => WriteForeign (Array a) where 311 | writeImpl xs = unsafeToForeign $ writeImpl <$> xs 312 | 313 | instance writeForeignMaybe :: WriteForeign a => WriteForeign (Maybe a) where 314 | writeImpl = maybe undefined writeImpl 315 | 316 | instance writeForeignNullable :: WriteForeign a => WriteForeign (Nullable a) where 317 | writeImpl = maybe (unsafeToForeign $ toNullable Nothing) writeImpl <<< toMaybe 318 | 319 | instance writeForeignObject :: WriteForeign a => WriteForeign (Object.Object a) where 320 | writeImpl = unsafeToForeign <<< Object.mapWithKey (const writeImpl) 321 | 322 | instance recordWriteForeign :: 323 | ( RowToList row rl 324 | , WriteForeignFields rl row () to 325 | ) => WriteForeign (Record row) where 326 | writeImpl rec = unsafeToForeign $ Builder.build steps {} 327 | where 328 | rlp = Proxy :: Proxy rl 329 | steps = writeImplFields rlp rec 330 | 331 | class WriteForeignFields (rl :: RowList Type) row (from :: Row Type) (to :: Row Type) 332 | | rl -> row from to where 333 | writeImplFields :: forall g. g rl -> Record row -> Builder (Record from) (Record to) 334 | 335 | instance consWriteForeignFields :: 336 | ( IsSymbol name 337 | , WriteForeign ty 338 | , WriteForeignFields tail row from from' 339 | , Row.Cons name ty whatever row 340 | , Row.Lacks name from' 341 | , Row.Cons name Foreign from' to 342 | ) => WriteForeignFields (Cons name ty tail) row from to where 343 | writeImplFields _ rec = result 344 | where 345 | namep = Proxy :: Proxy name 346 | value = writeImpl $ get namep rec 347 | tailp = Proxy :: Proxy tail 348 | rest = writeImplFields tailp rec 349 | result = Builder.insert namep value <<< rest 350 | instance nilWriteForeignFields :: 351 | WriteForeignFields Nil row () () where 352 | writeImplFields _ _ = identity 353 | 354 | instance writeForeignVariant :: 355 | ( RowToList row rl 356 | , WriteForeignVariant rl row 357 | ) => WriteForeign (Variant row) where 358 | writeImpl variant = writeVariantImpl (Proxy :: Proxy rl) variant 359 | 360 | class WriteForeignVariant (rl :: RowList Type) (row :: Row Type) 361 | | rl -> row where 362 | writeVariantImpl :: forall g. g rl -> Variant row -> Foreign 363 | 364 | instance nilWriteForeignVariant :: 365 | WriteForeignVariant Nil () where 366 | writeVariantImpl _ _ = 367 | -- a PureScript-defined variant cannot reach this path, but a JavaScript FFI one could. 368 | unsafeCrashWith "Variant was not able to be writen row WriteForeign." 369 | 370 | instance consWriteForeignVariant :: 371 | ( IsSymbol name 372 | , WriteForeign ty 373 | , Row.Cons name ty subRow row 374 | , WriteForeignVariant tail subRow 375 | ) => WriteForeignVariant (Cons name ty tail) row where 376 | writeVariantImpl _ variant = 377 | on 378 | namep 379 | writeVariant 380 | (writeVariantImpl (Proxy :: Proxy tail)) 381 | variant 382 | where 383 | namep = Proxy :: Proxy name 384 | writeVariant value = unsafeToForeign 385 | { type: reflectSymbol namep 386 | , value: writeImpl value 387 | } 388 | 389 | instance readForeignNEArray :: ReadForeign a => ReadForeign (NonEmptyArray a) where 390 | readImpl f = do 391 | raw :: Array a <- readImpl f 392 | except $ note (singleton $ ForeignError "Nonempty array expected, got empty array") $ fromArray raw 393 | 394 | instance writeForeignNEArray :: WriteForeign a => WriteForeign (NonEmptyArray a) where 395 | writeImpl a = writeImpl <<< toArray $ a 396 | --------------------------------------------------------------------------------