├── src └── Foreign │ ├── NullOrUndefined.js │ ├── Internal │ ├── Stringify.js │ └── Stringify.purs │ ├── JSON.js │ ├── Class.purs │ ├── NullOrUndefined.purs │ ├── Generic │ ├── Internal.purs │ ├── Enum.purs │ └── Class.purs │ ├── JSON.purs │ └── Generic.purs ├── .gitignore ├── .travis.yml ├── generated-docs └── Foreign │ ├── JSON.md │ ├── Generic │ ├── Internal.md │ ├── EnumEncoding.md │ └── Class.md │ ├── NullOrUndefined.md │ ├── Class.md │ └── Generic.md ├── package.json ├── bower.json ├── README.md ├── LICENSE └── test ├── Types.purs └── Main.purs /src/Foreign/NullOrUndefined.js: -------------------------------------------------------------------------------- 1 | exports['null'] = null; 2 | 3 | exports['undefined'] = undefined; 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .psci* 2 | bower_components/ 3 | node_modules/ 4 | output/ 5 | .psc-package 6 | .psc-ide-port 7 | -------------------------------------------------------------------------------- /src/Foreign/Internal/Stringify.js: -------------------------------------------------------------------------------- 1 | exports.unsafeStringify = function (x) { 2 | return JSON.stringify(x); 3 | }; 4 | -------------------------------------------------------------------------------- /src/Foreign/JSON.js: -------------------------------------------------------------------------------- 1 | "use strict"; 2 | 3 | exports.parseJSONImpl = function (str) { 4 | return JSON.parse(str); 5 | }; 6 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: node_js 2 | dist: trusty 3 | sudo: required 4 | node_js: stable 5 | install: 6 | - npm install -g bower 7 | - npm install 8 | script: 9 | - bower install --production 10 | - npm run -s build 11 | - bower install 12 | - npm run -s test 13 | -------------------------------------------------------------------------------- /src/Foreign/Internal/Stringify.purs: -------------------------------------------------------------------------------- 1 | module Foreign.Internal.Stringify (unsafeStringify) where 2 | 3 | -- | Uses the global JSON object to turn anything into a string. Careful! Trying 4 | -- | to serialize functions returns undefined 5 | foreign import unsafeStringify :: forall a. a -> String 6 | -------------------------------------------------------------------------------- /src/Foreign/Class.purs: -------------------------------------------------------------------------------- 1 | -- | This module is provided for backwards-compatibility with the old API. 2 | -- | 3 | -- | It is liable to be removed in a future release. 4 | 5 | module Foreign.Class 6 | ( module Reexports 7 | ) where 8 | 9 | import Foreign.Generic.Class (class Decode, class Encode, decode, encode) as Reexports 10 | -------------------------------------------------------------------------------- /generated-docs/Foreign/JSON.md: -------------------------------------------------------------------------------- 1 | ## Module Foreign.JSON 2 | 3 | #### `parseJSON` 4 | 5 | ``` purescript 6 | parseJSON :: String -> F Foreign 7 | ``` 8 | 9 | Parse a JSON string as `Foreign` data 10 | 11 | #### `decodeJSONWith` 12 | 13 | ``` purescript 14 | decodeJSONWith :: forall a. (Foreign -> F a) -> String -> F a 15 | ``` 16 | 17 | 18 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "private": true, 3 | "scripts": { 4 | "clean": "rimraf output && rimraf .pulp-cache", 5 | "build": "pulp build -- --censor-lib --strict", 6 | "test": "pulp test" 7 | }, 8 | "devDependencies": { 9 | "pulp": "^15.0.0", 10 | "purescript": "^0.14.0", 11 | "purescript-psa": "^0.5.0", 12 | "rimraf": "^2.5.0" 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /generated-docs/Foreign/Generic/Internal.md: -------------------------------------------------------------------------------- 1 | ## Module Foreign.Generic.Internal 2 | 3 | #### `isObject` 4 | 5 | ``` purescript 6 | isObject :: Foreign -> Boolean 7 | ``` 8 | 9 | Test whether a foreign value is a dictionary 10 | 11 | #### `readObject` 12 | 13 | ``` purescript 14 | readObject :: Foreign -> F (Object Foreign) 15 | ``` 16 | 17 | Attempt to coerce a foreign value to an `Object`. 18 | 19 | 20 | -------------------------------------------------------------------------------- /generated-docs/Foreign/NullOrUndefined.md: -------------------------------------------------------------------------------- 1 | ## Module Foreign.NullOrUndefined 2 | 3 | #### `readNullOrUndefined` 4 | 5 | ``` purescript 6 | readNullOrUndefined :: forall a. (Foreign -> F a) -> Foreign -> F (Maybe a) 7 | ``` 8 | 9 | Read a value which may be null or undefined. 10 | 11 | #### `undefined` 12 | 13 | ``` purescript 14 | undefined :: Foreign 15 | ``` 16 | 17 | #### `null` 18 | 19 | ``` purescript 20 | null :: Foreign 21 | ``` 22 | 23 | 24 | -------------------------------------------------------------------------------- /src/Foreign/NullOrUndefined.purs: -------------------------------------------------------------------------------- 1 | module Foreign.NullOrUndefined where 2 | 3 | import Prelude 4 | 5 | import Data.Maybe (Maybe(..)) 6 | import Foreign (F, Foreign, isUndefined, isNull) 7 | 8 | -- | Read a value which may be null or undefined. 9 | readNullOrUndefined :: forall a. (Foreign -> F a) -> Foreign -> F (Maybe a) 10 | readNullOrUndefined _ value | isNull value || isUndefined value = pure Nothing 11 | readNullOrUndefined f value = Just <$> f value 12 | 13 | foreign import undefined :: Foreign 14 | 15 | foreign import null :: Foreign 16 | -------------------------------------------------------------------------------- /src/Foreign/Generic/Internal.purs: -------------------------------------------------------------------------------- 1 | module Foreign.Generic.Internal where 2 | 3 | import Prelude 4 | 5 | import Foreign (F, Foreign, ForeignError(..), fail, tagOf, unsafeFromForeign) 6 | import Foreign.Object (Object) 7 | 8 | -- | Test whether a foreign value is a dictionary 9 | isObject :: Foreign -> Boolean 10 | isObject v = tagOf v == "Object" 11 | 12 | -- | Attempt to coerce a foreign value to an `Object`. 13 | readObject :: Foreign -> F (Object Foreign) 14 | readObject value 15 | | isObject value = pure $ unsafeFromForeign value 16 | | otherwise = fail $ TypeMismatch "Object" (tagOf value) 17 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-foreign-generic", 3 | "moduleType": [ 4 | "node" 5 | ], 6 | "ignore": [ 7 | "**/.*", 8 | "node_modules", 9 | "bower_components", 10 | "output" 11 | ], 12 | "license": "MIT", 13 | "repository": { 14 | "type": "git", 15 | "url": "git://github.com/paf31/purescript-foreign-generic.git" 16 | }, 17 | "dependencies": { 18 | "purescript-effect": "^3.0.0", 19 | "purescript-foreign": "^6.0.0", 20 | "purescript-foreign-object": "^3.0.0", 21 | "purescript-ordered-collections": "^2.0.0", 22 | "purescript-exceptions": "^5.0.0", 23 | "purescript-record": "^3.0.0", 24 | "purescript-identity": "^5.0.0" 25 | }, 26 | "devDependencies": { 27 | "purescript-assert": "^5.0.0", 28 | "purescript-psci-support": "^5.0.0" 29 | } 30 | } 31 | -------------------------------------------------------------------------------- /src/Foreign/JSON.purs: -------------------------------------------------------------------------------- 1 | module Foreign.JSON 2 | ( parseJSON 3 | , decodeJSONWith 4 | ) where 5 | 6 | import Control.Monad.Except (ExceptT(..)) 7 | import Data.Bifunctor (lmap) 8 | import Data.Identity (Identity(..)) 9 | import Effect.Exception (message, try) 10 | import Effect.Uncurried (EffectFn1, runEffectFn1) 11 | import Effect.Unsafe (unsafePerformEffect) 12 | import Foreign (Foreign, ForeignError(..), F) 13 | import Prelude 14 | 15 | foreign import parseJSONImpl :: EffectFn1 String Foreign 16 | 17 | -- | Parse a JSON string as `Foreign` data 18 | parseJSON :: String -> F Foreign 19 | parseJSON = 20 | ExceptT 21 | <<< Identity 22 | <<< lmap (pure <<< ForeignError <<< message) 23 | <<< unsafePerformEffect 24 | <<< try 25 | <<< runEffectFn1 parseJSONImpl 26 | 27 | decodeJSONWith :: forall a. (Foreign -> F a) -> String -> F a 28 | decodeJSONWith f = f <=< parseJSON 29 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # purescript-foreign-generic 2 | 3 | [![Build Status](https://travis-ci.org/paf31/purescript-foreign-generic.svg?branch=master)](https://travis-ci.org/paf31/purescript-foreign-generic) 4 | 5 | Generic deriving for `purescript-foreign`. 6 | 7 | - [Module Documentation](generated-docs/Foreign/Generic.md) 8 | - [Example](test/Main.purs) 9 | - [Further examples in this repo](https://github.com/justinwoo/purescript-howto-foreign-generic) 10 | 11 | ## Example Usage 12 | 13 | First, define some data type and derive `Generic`: 14 | 15 | ```purescript 16 | > import Prelude 17 | > import Data.Generic.Rep (class Generic) 18 | > import Data.Show.Generic (genericShow) 19 | 20 | > newtype MyRecord = MyRecord { a :: Int } 21 | > derive instance genericMyRecord :: Generic MyRecord _ 22 | > instance showMyRecord :: Show MyRecord where show = genericShow 23 | ``` 24 | 25 | To encode JSON, use `genericEncodeJSON`: 26 | 27 | ```purescript 28 | > import Foreign.Generic (defaultOptions, genericEncodeJSON) 29 | 30 | > opts = defaultOptions { unwrapSingleConstructors = true } 31 | 32 | > genericEncodeJSON opts (MyRecord { a: 1 }) 33 | "{\"a\":1}" 34 | ``` 35 | 36 | And to decode JSON, use `genericDecodeJSON`: 37 | 38 | ```purescript 39 | > import Control.Monad.Except (runExcept) 40 | > import Foreign.Generic (genericDecodeJSON) 41 | 42 | > runExcept (genericDecodeJSON opts "{\"a\":1}" :: _ MyRecord) 43 | (Right (MyRecord { a: 1 })) 44 | ``` 45 | 46 | Badly formed JSON will result in a useful error, which can be inspected or pretty-printed: 47 | 48 | ```purescript 49 | > import Data.Bifunctor (lmap) 50 | > import Foreign (renderForeignError) 51 | 52 | > lmap (map renderForeignError) $ runExcept (genericDecodeJSON opts "{\"a\":\"abc\"}" :: _ MyRecord) 53 | (Left 54 | (NonEmptyList 55 | (NonEmpty 56 | "Error at array index 0: (ErrorAtProperty \"a\" (TypeMismatch \"Int\" \"String\"))" 57 | Nil))) 58 | ``` 59 | -------------------------------------------------------------------------------- /generated-docs/Foreign/Class.md: -------------------------------------------------------------------------------- 1 | ## Module Foreign.Class 2 | 3 | This module is provided for backwards-compatibility with the old API. 4 | 5 | It is liable to be removed in a future release. 6 | 7 | 8 | ### Re-exported from Foreign.Generic.Class: 9 | 10 | #### `Decode` 11 | 12 | ``` purescript 13 | class Decode a where 14 | decode :: Foreign -> F a 15 | ``` 16 | 17 | The `Decode` class is used to generate decoding functions 18 | of the form `Foreign -> F a` using `generics-rep` deriving. 19 | 20 | First, derive `Generic` for your data: 21 | 22 | ```purescript 23 | import Data.Generic.Rep 24 | 25 | data MyType = MyType ... 26 | 27 | derive instance genericMyType :: Generic MyType _ 28 | ``` 29 | 30 | You can then use the `genericDecode` and `genericDecodeJSON` functions 31 | to decode your foreign/JSON-encoded data. 32 | 33 | ##### Instances 34 | ``` purescript 35 | Decode Void 36 | Decode Unit 37 | Decode Foreign 38 | Decode String 39 | Decode Char 40 | Decode Boolean 41 | Decode Number 42 | Decode Int 43 | (Decode a) => Decode (Identity a) 44 | (Decode a) => Decode (Array a) 45 | (Decode a) => Decode (Maybe a) 46 | (Decode v) => Decode (Object v) 47 | (RowToList r rl, DecodeRecord r rl) => Decode { | r } 48 | ``` 49 | 50 | #### `Encode` 51 | 52 | ``` purescript 53 | class Encode a where 54 | encode :: a -> Foreign 55 | ``` 56 | 57 | The `Encode` class is used to generate encoding functions 58 | of the form `a -> Foreign` using `generics-rep` deriving. 59 | 60 | First, derive `Generic` for your data: 61 | 62 | ```purescript 63 | import Data.Generic.Rep 64 | 65 | data MyType = MyType ... 66 | 67 | derive instance genericMyType :: Generic MyType _ 68 | ``` 69 | 70 | You can then use the `genericEncode` and `genericEncodeJSON` functions 71 | to encode your data as JSON. 72 | 73 | ##### Instances 74 | ``` purescript 75 | Encode Void 76 | Encode Unit 77 | Encode Foreign 78 | Encode String 79 | Encode Char 80 | Encode Boolean 81 | Encode Number 82 | Encode Int 83 | (Encode a) => Encode (Identity a) 84 | (Encode a) => Encode (Array a) 85 | (Encode a) => Encode (Maybe a) 86 | (Encode v) => Encode (Object v) 87 | (RowToList r rl, EncodeRecord r rl) => Encode { | r } 88 | ``` 89 | 90 | -------------------------------------------------------------------------------- /src/Foreign/Generic.purs: -------------------------------------------------------------------------------- 1 | module Foreign.Generic 2 | ( genericDecode 3 | , genericEncode 4 | , decodeJSON 5 | , encodeJSON 6 | , genericDecodeJSON 7 | , genericEncodeJSON 8 | , module Reexports 9 | ) where 10 | 11 | import Prelude 12 | 13 | import Data.Generic.Rep (class Generic, from, to) 14 | import Foreign (F, Foreign) 15 | import Foreign (F, Foreign, ForeignError(..)) as Reexports 16 | import Foreign.Generic.Class (class Decode, class Encode, class GenericDecode, class GenericEncode, Options, decode, decodeOpts, encode, encodeOpts) 17 | import Foreign.Generic.Class (class Decode, class Encode, class GenericDecode, class GenericEncode, Options, SumEncoding(..), defaultOptions, decode, encode) as Reexports 18 | import Foreign.Internal.Stringify (unsafeStringify) 19 | import Foreign.JSON (decodeJSONWith, parseJSON) 20 | 21 | -- | Read a value which has a `Generic` type. 22 | genericDecode 23 | :: forall a rep 24 | . Generic a rep 25 | => GenericDecode rep 26 | => Options 27 | -> Foreign 28 | -> F a 29 | genericDecode opts = map to <<< decodeOpts opts 30 | 31 | -- | Generate a `Foreign` value compatible with the `genericDecode` function. 32 | genericEncode 33 | :: forall a rep 34 | . Generic a rep 35 | => GenericEncode rep 36 | => Options 37 | -> a 38 | -> Foreign 39 | genericEncode opts = encodeOpts opts <<< from 40 | 41 | -- | Decode a JSON string using a `Decode` instance. 42 | decodeJSON 43 | :: forall a 44 | . Decode a 45 | => String 46 | -> F a 47 | decodeJSON = decodeJSONWith decode 48 | 49 | -- | Encode a JSON string using an `Encode` instance. 50 | encodeJSON 51 | :: forall a 52 | . Encode a 53 | => a 54 | -> String 55 | encodeJSON = unsafeStringify <<< encode 56 | 57 | -- | Read a value which has a `Generic` type from a JSON String 58 | genericDecodeJSON 59 | :: forall a rep 60 | . Generic a rep 61 | => GenericDecode rep 62 | => Options 63 | -> String 64 | -> F a 65 | genericDecodeJSON opts = genericDecode opts <=< parseJSON 66 | 67 | -- | Write a value which has a `Generic` type as a JSON String 68 | genericEncodeJSON 69 | :: forall a rep 70 | . Generic a rep 71 | => GenericEncode rep 72 | => Options 73 | -> a 74 | -> String 75 | genericEncodeJSON opts = unsafeStringify <<< genericEncode opts 76 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2017 Phil Freeman 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy of 6 | this software and associated documentation files (the "Software"), to deal in 7 | the Software without restriction, including without limitation the rights to 8 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of 9 | the Software, and to permit persons to whom the Software is furnished to do so, 10 | 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, FITNESS 17 | FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 18 | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 19 | IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 20 | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 21 | 22 | purescript-foreign-generic uses code taken from the purescript-foreign library, 23 | which is used under the terms of the MIT license, below: 24 | 25 | The MIT License (MIT) 26 | 27 | Copyright (c) 2014 PureScript 28 | 29 | Permission is hereby granted, free of charge, to any person obtaining a copy of 30 | this software and associated documentation files (the "Software"), to deal in 31 | the Software without restriction, including without limitation the rights to 32 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of 33 | the Software, and to permit persons to whom the Software is furnished to do so, 34 | subject to the following conditions: 35 | 36 | The above copyright notice and this permission notice shall be included in all 37 | copies or substantial portions of the Software. 38 | 39 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 40 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS 41 | FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR 42 | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER 43 | IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 44 | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 45 | -------------------------------------------------------------------------------- /generated-docs/Foreign/Generic/EnumEncoding.md: -------------------------------------------------------------------------------- 1 | ## Module Foreign.Generic.EnumEncoding 2 | 3 | #### `GenericEnumOptions` 4 | 5 | ``` purescript 6 | type GenericEnumOptions = { constructorTagTransform :: String -> String } 7 | ``` 8 | 9 | #### `defaultGenericEnumOptions` 10 | 11 | ``` purescript 12 | defaultGenericEnumOptions :: GenericEnumOptions 13 | ``` 14 | 15 | #### `genericDecodeEnum` 16 | 17 | ``` purescript 18 | genericDecodeEnum :: forall a rep. Generic a rep => GenericDecodeEnum rep => GenericEnumOptions -> Foreign -> F a 19 | ``` 20 | 21 | A generic function to be used with "Enums", or sum types with only no-argument constructors. This is used for decoding from strings to one of the constructors, combined with the `constructorTagTransform` property of `SumEncoding`. 22 | 23 | #### `genericEncodeEnum` 24 | 25 | ``` purescript 26 | genericEncodeEnum :: forall a rep. Generic a rep => GenericEncodeEnum rep => GenericEnumOptions -> a -> Foreign 27 | ``` 28 | 29 | A generic function to be used with "Enums", or sum types with only no-argument constructors. This is used for encoding to strings from one of the constructors, combined with the `constructorTagTransform` property of `SumEncoding`. 30 | 31 | For example: 32 | 33 | ```purescript 34 | data Fruit = Apple | Banana | Frikandel 35 | derive instance geFruit :: Generic Fruit _ 36 | instance eFruit :: Encode Fruit where 37 | encode = genericEncodeEnum defaultGenericEnumOptions 38 | 39 | #### `GenericDecodeEnum` 40 | 41 | ``` purescript 42 | class GenericDecodeEnum a where 43 | decodeEnum :: GenericEnumOptions -> Foreign -> F a 44 | ``` 45 | 46 | A type class for type representations that can be used for decoding to an Enum. Only the sum and no-argument constructor instances are valid, while others provide a `Fail` constraint to fail in compilation. 47 | 48 | For example: 49 | 50 | ```purescript 51 | data Fruit = Apple | Banana | Frikandel 52 | derive instance geFruit :: Generic Fruit _ 53 | instance dFruit :: Decode Fruit where 54 | decode = genericDecodeEnum defaultGenericEnumOptions 55 | ``` 56 | 57 | ##### Instances 58 | ``` purescript 59 | (GenericDecodeEnum a, GenericDecodeEnum b) => GenericDecodeEnum (Sum a b) 60 | (IsSymbol name) => GenericDecodeEnum (Constructor name NoArguments) 61 | (Fail (Text "genericEncode/DecodeEnum cannot be used on types that are not sums of constructors with no arguments.")) => GenericDecodeEnum (Constructor name (Argument a)) 62 | (Fail (Text "genericEncode/DecodeEnum cannot be used on types that are not sums of constructors with no arguments.")) => GenericDecodeEnum (Constructor name (Product a b)) 63 | ``` 64 | 65 | #### `GenericEncodeEnum` 66 | 67 | ``` purescript 68 | class GenericEncodeEnum a where 69 | encodeEnum :: GenericEnumOptions -> a -> Foreign 70 | ``` 71 | 72 | A type class for type representations that can be used for encoding from an Enum. Only the sum and no-argument constructor instances are valid, while others provide a `Fail` constraint to fail in compilation. 73 | 74 | ##### Instances 75 | ``` purescript 76 | (GenericEncodeEnum a, GenericEncodeEnum b) => GenericEncodeEnum (Sum a b) 77 | (IsSymbol name) => GenericEncodeEnum (Constructor name NoArguments) 78 | (Fail (Text "genericEncode/DecodeEnum cannot be used on types that are not sums of constructors with no arguments.")) => GenericEncodeEnum (Constructor name (Argument a)) 79 | (Fail (Text "genericEncode/DecodeEnum cannot be used on types that are not sums of constructors with no arguments.")) => GenericEncodeEnum (Constructor name (Product a b)) 80 | ``` 81 | 82 | 83 | -------------------------------------------------------------------------------- /test/Types.purs: -------------------------------------------------------------------------------- 1 | module Test.Types where 2 | 3 | import Prelude 4 | 5 | import Data.Bifunctor (class Bifunctor) 6 | import Foreign (ForeignError(..), fail, readArray, unsafeToForeign) 7 | import Foreign.Generic (class Encode, class Decode, Options, SumEncoding(..), encode, decode, defaultOptions, genericDecode, genericEncode) 8 | import Foreign.Generic.EnumEncoding (defaultGenericEnumOptions, genericDecodeEnum, genericEncodeEnum) 9 | import Data.Generic.Rep (class Generic) 10 | import Data.Eq.Generic (genericEq) 11 | import Data.Show.Generic (genericShow) 12 | import Data.Maybe (Maybe) 13 | import Data.Tuple (Tuple(..)) 14 | 15 | newtype TupleArray a b = TupleArray (Tuple a b) 16 | 17 | derive newtype instance bifunctorTupleArray :: Bifunctor TupleArray 18 | 19 | derive instance genericTupleArray :: Generic (TupleArray a b) _ 20 | 21 | instance showTupleArray :: (Show a, Show b) => Show (TupleArray a b) where 22 | show x = genericShow x 23 | 24 | instance eqTupleArray :: (Eq a, Eq b) => Eq (TupleArray a b) where 25 | eq x y = genericEq x y 26 | 27 | instance decodeTupleArray :: (Decode a, Decode b) => Decode (TupleArray a b) where 28 | decode x = do 29 | arr <- readArray x 30 | case arr of 31 | [y, z] -> TupleArray <$> (Tuple <$> decode y <*> decode z) 32 | _ -> fail (ForeignError "Expected two array elements") 33 | 34 | instance encodeTupleArray :: (Encode a, Encode b) => Encode (TupleArray a b) where 35 | encode (TupleArray (Tuple a b)) = unsafeToForeign [encode a, encode b] 36 | 37 | -- | An example record 38 | newtype RecordTest = RecordTest 39 | { foo :: Int 40 | , bar :: String 41 | , baz :: Char 42 | } 43 | 44 | derive instance genericRecordTest :: Generic RecordTest _ 45 | 46 | instance showRecordTest :: Show RecordTest where 47 | show x = genericShow x 48 | 49 | instance eqRecordTest :: Eq RecordTest where 50 | eq x y = genericEq x y 51 | 52 | instance decodeRecordTest :: Decode RecordTest where 53 | decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x 54 | 55 | instance encodeRecordTest :: Encode RecordTest where 56 | encode x = genericEncode (defaultOptions { unwrapSingleConstructors = true }) x 57 | 58 | -- | An example of an ADT with nullary constructors 59 | data IntList = Nil | Cons Int IntList 60 | 61 | derive instance genericIntList :: Generic IntList _ 62 | 63 | instance showIntList :: Show IntList where 64 | show x = genericShow x 65 | 66 | instance eqIntList :: Eq IntList where 67 | eq x y = genericEq x y 68 | 69 | intListOptions :: Options 70 | intListOptions = 71 | defaultOptions { unwrapSingleConstructors = true 72 | , sumEncoding = TaggedObject { tagFieldName: "tag" 73 | , contentsFieldName: "contents" 74 | , constructorTagTransform: \tag -> case tag of 75 | "Cons" -> "cOnS" 76 | _ -> "" 77 | } 78 | } 79 | 80 | instance decodeIntList :: Decode IntList where 81 | decode x = genericDecode intListOptions x 82 | 83 | instance encodeIntList :: Encode IntList where 84 | encode x = genericEncode intListOptions x 85 | 86 | -- | Balanced binary leaf trees 87 | data Tree a = Leaf a | Branch (Tree (TupleArray a a)) 88 | 89 | derive instance genericTree :: Generic (Tree a) _ 90 | 91 | instance showTree :: Show a => Show (Tree a) where 92 | show x = genericShow x 93 | 94 | instance eqTree :: Eq a => Eq (Tree a) where 95 | eq x y = genericEq x y 96 | 97 | instance decodeTree :: Decode a => Decode (Tree a) where 98 | decode x = genericDecode defaultOptions x 99 | 100 | instance encodeTree :: Encode a => Encode (Tree a) where 101 | encode x = genericEncode defaultOptions x 102 | 103 | newtype UndefinedTest = UndefinedTest 104 | { a :: Maybe String 105 | } 106 | 107 | derive instance eqUT :: Eq UndefinedTest 108 | derive instance geUT :: Generic UndefinedTest _ 109 | 110 | instance dUT :: Decode UndefinedTest where 111 | decode = genericDecode $ defaultOptions 112 | instance eUT :: Encode UndefinedTest where 113 | encode = genericEncode $ defaultOptions 114 | 115 | data Fruit 116 | = Apple 117 | | Banana 118 | | Frikandel 119 | 120 | derive instance eqFruit :: Eq Fruit 121 | derive instance geFruit :: Generic Fruit _ 122 | 123 | instance dFruit :: Decode Fruit where 124 | decode = genericDecodeEnum defaultGenericEnumOptions 125 | instance eFruit :: Encode Fruit where 126 | encode = genericEncodeEnum defaultGenericEnumOptions 127 | -------------------------------------------------------------------------------- /test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Except (runExcept) 6 | import Data.Bifunctor (bimap) 7 | import Data.Either (Either(..)) 8 | import Data.Generic.Rep (class Generic) 9 | import Data.Maybe (Maybe(..), isNothing) 10 | import Data.String (toLower, toUpper) 11 | import Data.Tuple (Tuple(..)) 12 | import Effect (Effect) 13 | import Effect.Console (log) 14 | import Foreign (isNull, unsafeToForeign) 15 | import Foreign.Generic (class Decode, class Encode, class GenericDecode, class GenericEncode, Options, decode, encode, defaultOptions, decodeJSON, encodeJSON, genericDecodeJSON, genericEncodeJSON) 16 | import Foreign.Generic.EnumEncoding (class GenericDecodeEnum, class GenericEncodeEnum, GenericEnumOptions, genericDecodeEnum, genericEncodeEnum) 17 | import Foreign.Index (readProp) 18 | import Foreign.Internal.Stringify (unsafeStringify) 19 | import Foreign.JSON (parseJSON) 20 | import Foreign.Object as Object 21 | import Test.Assert (assert, assert') 22 | import Test.Types (Fruit(..), IntList(..), RecordTest(..), Tree(..), TupleArray(..), UndefinedTest(..)) 23 | 24 | buildTree :: forall a. (a -> TupleArray a a) -> Int -> a -> Tree a 25 | buildTree _ 0 a = Leaf a 26 | buildTree f n a = Branch $ buildTree (bimap f f) (n - 1) (f a) 27 | 28 | -- A balanced binary tree of depth N 29 | makeTree :: Int -> Tree Int 30 | makeTree n = buildTree (\i -> TupleArray (Tuple (2 * i) (2 * i + 1))) n 0 31 | 32 | throw :: String -> Effect Unit 33 | throw = flip assert' false 34 | 35 | testRoundTrip 36 | :: ∀ a 37 | . Eq a 38 | => Decode a 39 | => Encode a 40 | => a 41 | -> Effect Unit 42 | testRoundTrip x = do 43 | let json = encodeJSON x 44 | log json 45 | case runExcept (decodeJSON json) of 46 | Right y -> assert (x == y) 47 | Left err -> throw (show err) 48 | 49 | testGenericRoundTrip 50 | :: ∀ a r 51 | . Eq a 52 | => Generic a r 53 | => GenericDecode r 54 | => GenericEncode r 55 | => Options 56 | -> a 57 | -> Effect Unit 58 | testGenericRoundTrip opts x = do 59 | let json = genericEncodeJSON opts x 60 | log json 61 | case runExcept (genericDecodeJSON opts json) of 62 | Right y -> assert (x == y) 63 | Left err -> throw (show err) 64 | 65 | testOption 66 | :: ∀ a rep 67 | . Eq a 68 | => Generic a rep 69 | => GenericEncodeEnum rep 70 | => GenericDecodeEnum rep 71 | => GenericEnumOptions 72 | -> String 73 | -> a 74 | -> Effect Unit 75 | testOption options string value = do 76 | let json = unsafeStringify $ genericEncodeEnum options value 77 | log json 78 | case runExcept $ Tuple <$> decode' json <*> decode' string of 79 | Right (Tuple x y) -> assert (value == y && value == x) 80 | Left err -> throw (show err) 81 | where 82 | decode' = genericDecodeEnum options <=< parseJSON 83 | 84 | testUnaryConstructorLiteral :: Effect Unit 85 | testUnaryConstructorLiteral = do 86 | testOption (makeCasingOptions toUpper) "\"FRIKANDEL\"" Frikandel 87 | testOption (makeCasingOptions toLower) "\"frikandel\"" Frikandel 88 | where 89 | makeCasingOptions f = 90 | { constructorTagTransform: f 91 | } 92 | 93 | -- Test that `Nothing` record fields, when encoded to JSON, are present and 94 | -- encoded as `null` 95 | testNothingToNull :: Effect Unit 96 | testNothingToNull = 97 | let 98 | json = encode (UndefinedTest {a: Nothing}) 99 | in do 100 | log (encodeJSON json) 101 | case runExcept (pure json >>= readProp "contents" >>= readProp "a") of 102 | Right val -> 103 | when (not (isNull val)) 104 | (throw ("property 'a' was not null; got: " <> encodeJSON val)) 105 | Left err -> 106 | throw (show err) 107 | 108 | -- Test that `Maybe` fields which are not present in the JSON are decoded to 109 | -- `Nothing` 110 | testNothingFromMissing :: Effect Unit 111 | testNothingFromMissing = 112 | let 113 | json = unsafeToForeign 114 | { tag: "UndefinedTest" 115 | , contents: 0 116 | } 117 | in 118 | case runExcept (decode json) of 119 | Right (UndefinedTest x) -> 120 | when (not (isNothing x.a)) 121 | (throw ("Expected Nothing, got: " <> show x.a)) 122 | Left err -> 123 | throw (show err) 124 | 125 | main :: Effect Unit 126 | main = do 127 | testRoundTrip (RecordTest { foo: 1, bar: "test", baz: 'a' }) 128 | testRoundTrip (Cons 1 (Cons 2 (Cons 3 Nil))) 129 | testRoundTrip (UndefinedTest {a: Just "test"}) 130 | testRoundTrip (UndefinedTest {a: Nothing}) 131 | testRoundTrip [Just "test"] 132 | testRoundTrip [Nothing :: Maybe String] 133 | testRoundTrip (Apple) 134 | testRoundTrip (makeTree 0) 135 | testRoundTrip (makeTree 5) 136 | testRoundTrip (Object.fromFoldable [Tuple "one" 1, Tuple "two" 2]) 137 | testUnaryConstructorLiteral 138 | let opts = defaultOptions { fieldTransform = toUpper } 139 | testGenericRoundTrip opts (RecordTest { foo: 1, bar: "test", baz: 'a' }) 140 | testNothingToNull 141 | testNothingFromMissing 142 | -------------------------------------------------------------------------------- /src/Foreign/Generic/Enum.purs: -------------------------------------------------------------------------------- 1 | module Foreign.Generic.EnumEncoding where 2 | 3 | import Prelude 4 | 5 | import Control.Alt ((<|>)) 6 | import Data.Generic.Rep (class Generic, Argument, Constructor(..), NoArguments(..), Product, Sum(..), from, to) 7 | import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol) 8 | import Foreign (F, Foreign, ForeignError(..), fail, readString, unsafeToForeign) 9 | import Partial.Unsafe (unsafeCrashWith) 10 | import Prim.TypeError (class Fail, Text) 11 | 12 | type GenericEnumOptions = 13 | { constructorTagTransform :: String -> String 14 | } 15 | 16 | defaultGenericEnumOptions :: GenericEnumOptions 17 | defaultGenericEnumOptions = 18 | { constructorTagTransform: identity 19 | } 20 | 21 | -- | A generic function to be used with "Enums", or sum types with only no-argument constructors. This is used for decoding from strings to one of the constructors, combined with the `constructorTagTransform` property of `SumEncoding`. 22 | genericDecodeEnum 23 | :: forall a rep 24 | . Generic a rep 25 | => GenericDecodeEnum rep 26 | => GenericEnumOptions 27 | -> Foreign 28 | -> F a 29 | genericDecodeEnum opts = map to <<< decodeEnum opts 30 | 31 | -- | A generic function to be used with "Enums", or sum types with only no-argument constructors. This is used for encoding to strings from one of the constructors, combined with the `constructorTagTransform` property of `SumEncoding`. 32 | -- | 33 | -- | For example: 34 | -- | 35 | -- | ```purescript 36 | -- | data Fruit = Apple | Banana | Frikandel 37 | -- | derive instance geFruit :: Generic Fruit _ 38 | -- | instance eFruit :: Encode Fruit where 39 | -- | encode = genericEncodeEnum defaultGenericEnumOptions 40 | genericEncodeEnum 41 | :: forall a rep 42 | . Generic a rep 43 | => GenericEncodeEnum rep 44 | => GenericEnumOptions 45 | -> a 46 | -> Foreign 47 | genericEncodeEnum opts = encodeEnum opts <<< from 48 | 49 | -- | A type class for type representations that can be used for decoding to an Enum. Only the sum and no-argument constructor instances are valid, while others provide a `Fail` constraint to fail in compilation. 50 | -- | 51 | -- | For example: 52 | -- | 53 | -- | ```purescript 54 | -- | data Fruit = Apple | Banana | Frikandel 55 | -- | derive instance geFruit :: Generic Fruit _ 56 | -- | instance dFruit :: Decode Fruit where 57 | -- | decode = genericDecodeEnum defaultGenericEnumOptions 58 | -- | ``` 59 | class GenericDecodeEnum a where 60 | decodeEnum :: GenericEnumOptions -> Foreign -> F a 61 | 62 | -- | A type class for type representations that can be used for encoding from an Enum. Only the sum and no-argument constructor instances are valid, while others provide a `Fail` constraint to fail in compilation. 63 | class GenericEncodeEnum a where 64 | encodeEnum :: GenericEnumOptions -> a -> Foreign 65 | 66 | instance sumGenericDecodeEnum 67 | :: (GenericDecodeEnum a, GenericDecodeEnum b) 68 | => GenericDecodeEnum (Sum a b) where 69 | decodeEnum opts f = Inl <$> decodeEnum opts f <|> Inr <$> decodeEnum opts f 70 | 71 | instance ctorNoArgsGenericDecodeEnum 72 | :: IsSymbol name 73 | => GenericDecodeEnum (Constructor name NoArguments) where 74 | decodeEnum {constructorTagTransform} f = do 75 | tag <- readString f 76 | unless (tag == ctorName) $ 77 | fail (ForeignError ("Expected " <> show ctorName <> " tag for unary constructor literal " <> ctorName)) 78 | pure $ Constructor NoArguments 79 | where 80 | ctorName = constructorTagTransform $ reflectSymbol (SProxy :: SProxy name) 81 | 82 | instance ctorArgumentGenericDecodeEnum 83 | :: Fail (Text "genericEncode/DecodeEnum cannot be used on types that are not sums of constructors with no arguments.") 84 | => GenericDecodeEnum (Constructor name (Argument a)) where 85 | decodeEnum _ _ = unsafeCrashWith "unreachable decodeEnum was reached." 86 | 87 | instance ctorProductGenericDecodeEnum 88 | :: Fail (Text "genericEncode/DecodeEnum cannot be used on types that are not sums of constructors with no arguments.") 89 | => GenericDecodeEnum (Constructor name (Product a b)) where 90 | decodeEnum _ _ = unsafeCrashWith "unreachable decodeEnum was reached." 91 | 92 | instance sumGenericEncodeEnum 93 | :: (GenericEncodeEnum a, GenericEncodeEnum b) 94 | => GenericEncodeEnum (Sum a b) where 95 | encodeEnum opts (Inl a) = encodeEnum opts a 96 | encodeEnum opts (Inr b) = encodeEnum opts b 97 | 98 | instance ctorNoArgsGenericEncodeEnum 99 | :: IsSymbol name 100 | => GenericEncodeEnum (Constructor name NoArguments) where 101 | encodeEnum {constructorTagTransform} _ = unsafeToForeign ctorName 102 | where 103 | ctorName = constructorTagTransform $ reflectSymbol (SProxy :: SProxy name) 104 | 105 | instance ctorArgumentGenericEncodeEnum 106 | :: Fail (Text "genericEncode/DecodeEnum cannot be used on types that are not sums of constructors with no arguments.") 107 | => GenericEncodeEnum (Constructor name (Argument a)) where 108 | encodeEnum _ _ = unsafeCrashWith "unreachable encodeEnum was reached." 109 | 110 | instance ctorProductGenericEncodeEnum 111 | :: Fail (Text "genericEncode/DecodeEnum cannot be used on types that are not sums of constructors with no arguments.") 112 | => GenericEncodeEnum (Constructor name (Product a b)) where 113 | encodeEnum _ _ = unsafeCrashWith "unreachable encodeEnum was reached." 114 | -------------------------------------------------------------------------------- /generated-docs/Foreign/Generic.md: -------------------------------------------------------------------------------- 1 | ## Module Foreign.Generic 2 | 3 | #### `genericDecode` 4 | 5 | ``` purescript 6 | genericDecode :: forall a rep. Generic a rep => GenericDecode rep => Options -> Foreign -> F a 7 | ``` 8 | 9 | Read a value which has a `Generic` type. 10 | 11 | #### `genericEncode` 12 | 13 | ``` purescript 14 | genericEncode :: forall a rep. Generic a rep => GenericEncode rep => Options -> a -> Foreign 15 | ``` 16 | 17 | Generate a `Foreign` value compatible with the `genericDecode` function. 18 | 19 | #### `decodeJSON` 20 | 21 | ``` purescript 22 | decodeJSON :: forall a. Decode a => String -> F a 23 | ``` 24 | 25 | Decode a JSON string using a `Decode` instance. 26 | 27 | #### `encodeJSON` 28 | 29 | ``` purescript 30 | encodeJSON :: forall a. Encode a => a -> String 31 | ``` 32 | 33 | Encode a JSON string using an `Encode` instance. 34 | 35 | #### `genericDecodeJSON` 36 | 37 | ``` purescript 38 | genericDecodeJSON :: forall a rep. Generic a rep => GenericDecode rep => Options -> String -> F a 39 | ``` 40 | 41 | Read a value which has a `Generic` type from a JSON String 42 | 43 | #### `genericEncodeJSON` 44 | 45 | ``` purescript 46 | genericEncodeJSON :: forall a rep. Generic a rep => GenericEncode rep => Options -> a -> String 47 | ``` 48 | 49 | Write a value which has a `Generic` type as a JSON String 50 | 51 | 52 | ### Re-exported from Foreign: 53 | 54 | #### `ForeignError` 55 | 56 | ``` purescript 57 | data ForeignError 58 | = ForeignError String 59 | | TypeMismatch String String 60 | | ErrorAtIndex Int ForeignError 61 | | ErrorAtProperty String ForeignError 62 | ``` 63 | 64 | A type for foreign type errors 65 | 66 | ##### Instances 67 | ``` purescript 68 | Eq ForeignError 69 | Ord ForeignError 70 | Show ForeignError 71 | ``` 72 | 73 | #### `Foreign` 74 | 75 | ``` purescript 76 | data Foreign :: Type 77 | ``` 78 | 79 | A type for _foreign data_. 80 | 81 | Foreign data is data from any external _unknown_ or _unreliable_ 82 | source, for which it cannot be guaranteed that the runtime representation 83 | conforms to that of any particular type. 84 | 85 | Suitable applications of `Foreign` are 86 | 87 | - To represent responses from web services 88 | - To integrate with external JavaScript libraries. 89 | 90 | #### `F` 91 | 92 | ``` purescript 93 | type F = Except MultipleErrors 94 | ``` 95 | 96 | An error monad, used in this library to encode possible failures when 97 | dealing with foreign data. 98 | 99 | The `Alt` instance for `Except` allows us to accumulate errors, 100 | unlike `Either`, which preserves only the last error. 101 | 102 | ### Re-exported from Foreign.Generic.Class: 103 | 104 | #### `SumEncoding` 105 | 106 | ``` purescript 107 | data SumEncoding 108 | = TaggedObject { tagFieldName :: String, contentsFieldName :: String, constructorTagTransform :: String -> String } 109 | ``` 110 | 111 | The encoding of sum types for your type. 112 | `TaggedObject`s will be encoded in the form `{ [tagFieldName]: "ConstructorTag", [contentsFieldName]: "Contents"}`. 113 | `constructorTagTransform` can be provided to transform the constructor tag to a form you use, e.g. `toLower`/`toUpper`. 114 | 115 | #### `Options` 116 | 117 | ``` purescript 118 | type Options = { sumEncoding :: SumEncoding, unwrapSingleConstructors :: Boolean, unwrapSingleArguments :: Boolean, fieldTransform :: String -> String } 119 | ``` 120 | 121 | Encoding/Decoding options which can be used to customize 122 | `Decode` and `Encode` instances which are derived via 123 | `Generic` (see `genericEncode` and `genericDecode`). 124 | 125 | #### `Decode` 126 | 127 | ``` purescript 128 | class Decode a where 129 | decode :: Foreign -> F a 130 | ``` 131 | 132 | The `Decode` class is used to generate decoding functions 133 | of the form `Foreign -> F a` using `generics-rep` deriving. 134 | 135 | First, derive `Generic` for your data: 136 | 137 | ```purescript 138 | import Data.Generic.Rep 139 | 140 | data MyType = MyType ... 141 | 142 | derive instance genericMyType :: Generic MyType _ 143 | ``` 144 | 145 | You can then use the `genericDecode` and `genericDecodeJSON` functions 146 | to decode your foreign/JSON-encoded data. 147 | 148 | ##### Instances 149 | ``` purescript 150 | Decode Void 151 | Decode Unit 152 | Decode Foreign 153 | Decode String 154 | Decode Char 155 | Decode Boolean 156 | Decode Number 157 | Decode Int 158 | (Decode a) => Decode (Identity a) 159 | (Decode a) => Decode (Array a) 160 | (Decode a) => Decode (Maybe a) 161 | (Decode v) => Decode (Object v) 162 | (RowToList r rl, DecodeRecord r rl) => Decode { | r } 163 | ``` 164 | 165 | #### `Encode` 166 | 167 | ``` purescript 168 | class Encode a where 169 | encode :: a -> Foreign 170 | ``` 171 | 172 | The `Encode` class is used to generate encoding functions 173 | of the form `a -> Foreign` using `generics-rep` deriving. 174 | 175 | First, derive `Generic` for your data: 176 | 177 | ```purescript 178 | import Data.Generic.Rep 179 | 180 | data MyType = MyType ... 181 | 182 | derive instance genericMyType :: Generic MyType _ 183 | ``` 184 | 185 | You can then use the `genericEncode` and `genericEncodeJSON` functions 186 | to encode your data as JSON. 187 | 188 | ##### Instances 189 | ``` purescript 190 | Encode Void 191 | Encode Unit 192 | Encode Foreign 193 | Encode String 194 | Encode Char 195 | Encode Boolean 196 | Encode Number 197 | Encode Int 198 | (Encode a) => Encode (Identity a) 199 | (Encode a) => Encode (Array a) 200 | (Encode a) => Encode (Maybe a) 201 | (Encode v) => Encode (Object v) 202 | (RowToList r rl, EncodeRecord r rl) => Encode { | r } 203 | ``` 204 | 205 | #### `GenericDecode` 206 | 207 | ``` purescript 208 | class GenericDecode a 209 | ``` 210 | 211 | ##### Instances 212 | ``` purescript 213 | GenericDecode NoConstructors 214 | (IsSymbol name, GenericDecodeArgs rep, GenericCountArgs rep) => GenericDecode (Constructor name rep) 215 | (GenericDecode a, GenericDecode b) => GenericDecode (Sum a b) 216 | ``` 217 | 218 | #### `GenericEncode` 219 | 220 | ``` purescript 221 | class GenericEncode a 222 | ``` 223 | 224 | ##### Instances 225 | ``` purescript 226 | GenericEncode NoConstructors 227 | (IsSymbol name, GenericEncodeArgs rep) => GenericEncode (Constructor name rep) 228 | (GenericEncode a, GenericEncode b) => GenericEncode (Sum a b) 229 | ``` 230 | 231 | #### `defaultOptions` 232 | 233 | ``` purescript 234 | defaultOptions :: Options 235 | ``` 236 | 237 | Default decoding/encoding options: 238 | 239 | - Represent sum types as records with `tag` and `contents` fields 240 | - Unwrap single arguments 241 | - Don't unwrap single constructors 242 | - Use the constructor names as-is 243 | - Use the field names as-is 244 | 245 | -------------------------------------------------------------------------------- /generated-docs/Foreign/Generic/Class.md: -------------------------------------------------------------------------------- 1 | ## Module Foreign.Generic.Class 2 | 3 | #### `Options` 4 | 5 | ``` purescript 6 | type Options = { sumEncoding :: SumEncoding, unwrapSingleConstructors :: Boolean, unwrapSingleArguments :: Boolean, fieldTransform :: String -> String } 7 | ``` 8 | 9 | Encoding/Decoding options which can be used to customize 10 | `Decode` and `Encode` instances which are derived via 11 | `Generic` (see `genericEncode` and `genericDecode`). 12 | 13 | #### `SumEncoding` 14 | 15 | ``` purescript 16 | data SumEncoding 17 | = TaggedObject { tagFieldName :: String, contentsFieldName :: String, constructorTagTransform :: String -> String } 18 | ``` 19 | 20 | The encoding of sum types for your type. 21 | `TaggedObject`s will be encoded in the form `{ [tagFieldName]: "ConstructorTag", [contentsFieldName]: "Contents"}`. 22 | `constructorTagTransform` can be provided to transform the constructor tag to a form you use, e.g. `toLower`/`toUpper`. 23 | 24 | #### `defaultOptions` 25 | 26 | ``` purescript 27 | defaultOptions :: Options 28 | ``` 29 | 30 | Default decoding/encoding options: 31 | 32 | - Represent sum types as records with `tag` and `contents` fields 33 | - Unwrap single arguments 34 | - Don't unwrap single constructors 35 | - Use the constructor names as-is 36 | - Use the field names as-is 37 | 38 | #### `Decode` 39 | 40 | ``` purescript 41 | class Decode a where 42 | decode :: Foreign -> F a 43 | ``` 44 | 45 | The `Decode` class is used to generate decoding functions 46 | of the form `Foreign -> F a` using `generics-rep` deriving. 47 | 48 | First, derive `Generic` for your data: 49 | 50 | ```purescript 51 | import Data.Generic.Rep 52 | 53 | data MyType = MyType ... 54 | 55 | derive instance genericMyType :: Generic MyType _ 56 | ``` 57 | 58 | You can then use the `genericDecode` and `genericDecodeJSON` functions 59 | to decode your foreign/JSON-encoded data. 60 | 61 | ##### Instances 62 | ``` purescript 63 | Decode Void 64 | Decode Unit 65 | Decode Foreign 66 | Decode String 67 | Decode Char 68 | Decode Boolean 69 | Decode Number 70 | Decode Int 71 | (Decode a) => Decode (Identity a) 72 | (Decode a) => Decode (Array a) 73 | (Decode a) => Decode (Maybe a) 74 | (Decode v) => Decode (Object v) 75 | (RowToList r rl, DecodeRecord r rl) => Decode { | r } 76 | ``` 77 | 78 | #### `Encode` 79 | 80 | ``` purescript 81 | class Encode a where 82 | encode :: a -> Foreign 83 | ``` 84 | 85 | The `Encode` class is used to generate encoding functions 86 | of the form `a -> Foreign` using `generics-rep` deriving. 87 | 88 | First, derive `Generic` for your data: 89 | 90 | ```purescript 91 | import Data.Generic.Rep 92 | 93 | data MyType = MyType ... 94 | 95 | derive instance genericMyType :: Generic MyType _ 96 | ``` 97 | 98 | You can then use the `genericEncode` and `genericEncodeJSON` functions 99 | to encode your data as JSON. 100 | 101 | ##### Instances 102 | ``` purescript 103 | Encode Void 104 | Encode Unit 105 | Encode Foreign 106 | Encode String 107 | Encode Char 108 | Encode Boolean 109 | Encode Number 110 | Encode Int 111 | (Encode a) => Encode (Identity a) 112 | (Encode a) => Encode (Array a) 113 | (Encode a) => Encode (Maybe a) 114 | (Encode v) => Encode (Object v) 115 | (RowToList r rl, EncodeRecord r rl) => Encode { | r } 116 | ``` 117 | 118 | #### `DecodeWithOptions` 119 | 120 | ``` purescript 121 | class DecodeWithOptions a where 122 | decodeWithOptions :: Options -> Foreign -> F a 123 | ``` 124 | 125 | When deriving `En`/`Decode` instances using `Generic`, we want 126 | the `Options` object to apply to the outermost record type(s) 127 | under the data constructors. 128 | 129 | For this reason, we cannot use `En`/`Decode` directly when we 130 | reach an `Argument` during generic traversal of a type, because it 131 | might be a record type. Instead, we need to peel off any record 132 | type(s) and apply the appropriate `Options` before we can delegate 133 | to `En`/`Decode`, which can bake in its own `Options`. 134 | 135 | ##### Instances 136 | ``` purescript 137 | (RowToList r rl, DecodeRecord r rl) => DecodeWithOptions { | r } 138 | (Decode a) => DecodeWithOptions a 139 | ``` 140 | 141 | #### `EncodeWithOptions` 142 | 143 | ``` purescript 144 | class EncodeWithOptions a where 145 | encodeWithOptions :: Options -> a -> Foreign 146 | ``` 147 | 148 | See the comment on `DecodeWithOptions`. 149 | 150 | ##### Instances 151 | ``` purescript 152 | (RowToList r rl, EncodeRecord r rl) => EncodeWithOptions { | r } 153 | (Encode a) => EncodeWithOptions a 154 | ``` 155 | 156 | #### `DecodeRecord` 157 | 158 | ``` purescript 159 | class DecodeRecord r rl | rl -> r where 160 | decodeRecordWithOptions :: RLProxy rl -> Options -> Foreign -> F (Builder { } ({ | r })) 161 | ``` 162 | 163 | ##### Instances 164 | ``` purescript 165 | DecodeRecord () Nil 166 | (Cons l a r_ r, DecodeRecord r_ rl_, IsSymbol l, DecodeWithOptions a, Lacks l r_) => DecodeRecord r (Cons l a rl_) 167 | ``` 168 | 169 | #### `EncodeRecord` 170 | 171 | ``` purescript 172 | class EncodeRecord r rl | rl -> r where 173 | encodeRecordWithOptions :: RLProxy rl -> Options -> { | r } -> Object Foreign 174 | ``` 175 | 176 | ##### Instances 177 | ``` purescript 178 | EncodeRecord () Nil 179 | (Cons l a r_ r, EncodeRecord r_ rl_, IsSymbol l, EncodeWithOptions a) => EncodeRecord r (Cons l a rl_) 180 | ``` 181 | 182 | #### `GenericDecode` 183 | 184 | ``` purescript 185 | class GenericDecode a where 186 | decodeOpts :: Options -> Foreign -> F a 187 | ``` 188 | 189 | ##### Instances 190 | ``` purescript 191 | GenericDecode NoConstructors 192 | (IsSymbol name, GenericDecodeArgs rep, GenericCountArgs rep) => GenericDecode (Constructor name rep) 193 | (GenericDecode a, GenericDecode b) => GenericDecode (Sum a b) 194 | ``` 195 | 196 | #### `GenericEncode` 197 | 198 | ``` purescript 199 | class GenericEncode a where 200 | encodeOpts :: Options -> a -> Foreign 201 | ``` 202 | 203 | ##### Instances 204 | ``` purescript 205 | GenericEncode NoConstructors 206 | (IsSymbol name, GenericEncodeArgs rep) => GenericEncode (Constructor name rep) 207 | (GenericEncode a, GenericEncode b) => GenericEncode (Sum a b) 208 | ``` 209 | 210 | #### `GenericDecodeArgs` 211 | 212 | ``` purescript 213 | class GenericDecodeArgs a where 214 | decodeArgs :: Options -> Int -> List Foreign -> F { result :: a, rest :: List Foreign, next :: Int } 215 | ``` 216 | 217 | ##### Instances 218 | ``` purescript 219 | GenericDecodeArgs NoArguments 220 | (DecodeWithOptions a) => GenericDecodeArgs (Argument a) 221 | (GenericDecodeArgs a, GenericDecodeArgs b) => GenericDecodeArgs (Product a b) 222 | ``` 223 | 224 | #### `GenericEncodeArgs` 225 | 226 | ``` purescript 227 | class GenericEncodeArgs a where 228 | encodeArgs :: Options -> a -> List Foreign 229 | ``` 230 | 231 | ##### Instances 232 | ``` purescript 233 | GenericEncodeArgs NoArguments 234 | (EncodeWithOptions a) => GenericEncodeArgs (Argument a) 235 | (GenericEncodeArgs a, GenericEncodeArgs b) => GenericEncodeArgs (Product a b) 236 | ``` 237 | 238 | #### `GenericCountArgs` 239 | 240 | ``` purescript 241 | class GenericCountArgs a where 242 | countArgs :: Proxy a -> Either a Int 243 | ``` 244 | 245 | ##### Instances 246 | ``` purescript 247 | GenericCountArgs NoArguments 248 | GenericCountArgs (Argument a) 249 | (GenericCountArgs a, GenericCountArgs b) => GenericCountArgs (Product a b) 250 | ``` 251 | 252 | 253 | -------------------------------------------------------------------------------- /src/Foreign/Generic/Class.purs: -------------------------------------------------------------------------------- 1 | module Foreign.Generic.Class where 2 | 3 | import Prelude 4 | 5 | import Control.Alt ((<|>)) 6 | import Control.Monad.Except (except, mapExcept) 7 | import Data.Array ((..), zipWith, length) 8 | import Data.Bifunctor (lmap) 9 | import Data.Either (Either(..)) 10 | import Data.Generic.Rep (Argument(..), Constructor(..), NoArguments(..), NoConstructors, Product(..), Sum(..)) 11 | import Data.Identity (Identity(..)) 12 | import Data.List (List(..), (:)) 13 | import Data.List as List 14 | import Data.Maybe (Maybe(..), maybe) 15 | import Data.Newtype (unwrap) 16 | import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol) 17 | import Data.Traversable (sequence) 18 | import Foreign (F, Foreign, ForeignError(..), fail, readArray, readBoolean, readChar, readInt, readNumber, readString, unsafeToForeign) 19 | import Foreign.Generic.Internal (readObject) 20 | import Foreign.Index (index) 21 | import Foreign.NullOrUndefined (readNullOrUndefined, null) 22 | import Foreign.Object (Object) 23 | import Foreign.Object as Object 24 | import Prim.Row (class Cons, class Lacks) 25 | import Prim.RowList (class RowToList, Nil, Cons) 26 | import Record as Record 27 | import Record.Builder (Builder) 28 | import Record.Builder as Builder 29 | import Type.Data.RowList (RLProxy(..)) 30 | import Type.Proxy (Proxy(..)) 31 | import Unsafe.Coerce (unsafeCoerce) 32 | 33 | -- | Encoding/Decoding options which can be used to customize 34 | -- | `Decode` and `Encode` instances which are derived via 35 | -- | `Generic` (see `genericEncode` and `genericDecode`). 36 | type Options = 37 | { sumEncoding :: SumEncoding 38 | , unwrapSingleConstructors :: Boolean 39 | , unwrapSingleArguments :: Boolean 40 | , fieldTransform :: String -> String 41 | } 42 | 43 | -- | The encoding of sum types for your type. 44 | -- | `TaggedObject`s will be encoded in the form `{ [tagFieldName]: "ConstructorTag", [contentsFieldName]: "Contents"}`. 45 | -- | `constructorTagTransform` can be provided to transform the constructor tag to a form you use, e.g. `toLower`/`toUpper`. 46 | data SumEncoding 47 | = TaggedObject 48 | { tagFieldName :: String 49 | , contentsFieldName :: String 50 | , constructorTagTransform :: String -> String 51 | } 52 | 53 | -- | Default decoding/encoding options: 54 | -- | 55 | -- | - Represent sum types as records with `tag` and `contents` fields 56 | -- | - Unwrap single arguments 57 | -- | - Don't unwrap single constructors 58 | -- | - Use the constructor names as-is 59 | -- | - Use the field names as-is 60 | defaultOptions :: Options 61 | defaultOptions = 62 | { sumEncoding: 63 | TaggedObject 64 | { tagFieldName: "tag" 65 | , contentsFieldName: "contents" 66 | , constructorTagTransform: identity 67 | } 68 | , unwrapSingleConstructors: false 69 | , unwrapSingleArguments: true 70 | , fieldTransform: identity 71 | } 72 | 73 | -- | The `Decode` class is used to generate decoding functions 74 | -- | of the form `Foreign -> F a` using `generics-rep` deriving. 75 | -- | 76 | -- | First, derive `Generic` for your data: 77 | -- | 78 | -- | ```purescript 79 | -- | import Data.Generic.Rep 80 | -- | 81 | -- | data MyType = MyType ... 82 | -- | 83 | -- | derive instance genericMyType :: Generic MyType _ 84 | -- | ``` 85 | -- | 86 | -- | You can then use the `genericDecode` and `genericDecodeJSON` functions 87 | -- | to decode your foreign/JSON-encoded data. 88 | class Decode a where 89 | decode :: Foreign -> F a 90 | 91 | instance voidDecode :: Decode Void where 92 | decode _ = except (Left (pure (ForeignError "Decode: void"))) 93 | 94 | instance unitDecode :: Decode Unit where 95 | decode _ = pure unit 96 | 97 | instance foreignDecode :: Decode Foreign where 98 | decode = pure 99 | 100 | instance stringDecode :: Decode String where 101 | decode = readString 102 | 103 | instance charDecode :: Decode Char where 104 | decode = readChar 105 | 106 | instance booleanDecode :: Decode Boolean where 107 | decode = readBoolean 108 | 109 | instance numberDecode :: Decode Number where 110 | decode = readNumber 111 | 112 | instance intDecode :: Decode Int where 113 | decode = readInt 114 | 115 | instance identityDecode :: Decode a => Decode (Identity a) where 116 | decode = map Identity <<< decode 117 | 118 | instance arrayDecode :: Decode a => Decode (Array a) where 119 | decode = readArray >=> readElements where 120 | readElements :: Array Foreign -> F (Array a) 121 | readElements arr = sequence (zipWith readElement (0 .. length arr) arr) 122 | 123 | readElement :: Int -> Foreign -> F a 124 | readElement i value = mapExcept (lmap (map (ErrorAtIndex i))) (decode value) 125 | 126 | instance maybeDecode :: Decode a => Decode (Maybe a) where 127 | decode = readNullOrUndefined decode 128 | 129 | instance objectDecode :: Decode v => Decode (Object v) where 130 | decode = sequence <<< Object.mapWithKey (\_ -> decode) <=< readObject 131 | 132 | instance recordDecode :: (RowToList r rl, DecodeRecord r rl) => Decode (Record r) where 133 | decode = decodeWithOptions defaultOptions 134 | 135 | -- | The `Encode` class is used to generate encoding functions 136 | -- | of the form `a -> Foreign` using `generics-rep` deriving. 137 | -- | 138 | -- | First, derive `Generic` for your data: 139 | -- | 140 | -- | ```purescript 141 | -- | import Data.Generic.Rep 142 | -- | 143 | -- | data MyType = MyType ... 144 | -- | 145 | -- | derive instance genericMyType :: Generic MyType _ 146 | -- | ``` 147 | -- | 148 | -- | You can then use the `genericEncode` and `genericEncodeJSON` functions 149 | -- | to encode your data as JSON. 150 | class Encode a where 151 | encode :: a -> Foreign 152 | 153 | instance voidEncode :: Encode Void where 154 | encode = absurd 155 | 156 | instance unitEncode :: Encode Unit where 157 | encode _ = unsafeToForeign {} 158 | 159 | instance foreignEncode :: Encode Foreign where 160 | encode = identity 161 | 162 | instance stringEncode :: Encode String where 163 | encode = unsafeToForeign 164 | 165 | instance charEncode :: Encode Char where 166 | encode = unsafeToForeign 167 | 168 | instance booleanEncode :: Encode Boolean where 169 | encode = unsafeToForeign 170 | 171 | instance numberEncode :: Encode Number where 172 | encode = unsafeToForeign 173 | 174 | instance intEncode :: Encode Int where 175 | encode = unsafeToForeign 176 | 177 | instance identityEncode :: Encode a => Encode (Identity a) where 178 | encode = encode <<< unwrap 179 | 180 | instance arrayEncode :: Encode a => Encode (Array a) where 181 | encode = unsafeToForeign <<< map encode 182 | 183 | instance maybeEncode :: Encode a => Encode (Maybe a) where 184 | encode = maybe null encode 185 | 186 | instance objectEncode :: Encode v => Encode (Object v) where 187 | encode = unsafeToForeign <<< Object.mapWithKey (\_ -> encode) 188 | 189 | instance recordEncode :: (RowToList r rl, EncodeRecord r rl) => Encode (Record r) where 190 | encode = encodeWithOptions defaultOptions 191 | 192 | -- | When deriving `En`/`Decode` instances using `Generic`, we want 193 | -- | the `Options` object to apply to the outermost record type(s) 194 | -- | under the data constructors. 195 | -- | 196 | -- | For this reason, we cannot use `En`/`Decode` directly when we 197 | -- | reach an `Argument` during generic traversal of a type, because it 198 | -- | might be a record type. Instead, we need to peel off any record 199 | -- | type(s) and apply the appropriate `Options` before we can delegate 200 | -- | to `En`/`Decode`, which can bake in its own `Options`. 201 | class DecodeWithOptions a where 202 | decodeWithOptions :: Options -> Foreign -> F a 203 | 204 | -- | See the comment on `DecodeWithOptions`. 205 | class EncodeWithOptions a where 206 | encodeWithOptions :: Options -> a -> Foreign 207 | 208 | instance decodeWithOptionsRecord :: (RowToList r rl, DecodeRecord r rl) => DecodeWithOptions (Record r) where 209 | decodeWithOptions opts = map (flip Builder.build {}) <$> decodeRecordWithOptions (RLProxy :: RLProxy rl) opts 210 | else instance decodeWithOptionsOther :: Decode a => DecodeWithOptions a where 211 | decodeWithOptions _ = decode 212 | 213 | instance encodeWithOptionsRecord :: (RowToList r rl, EncodeRecord r rl) => EncodeWithOptions (Record r) where 214 | encodeWithOptions opts = unsafeToForeign <<< encodeRecordWithOptions (RLProxy :: RLProxy rl) opts 215 | else instance encodeWithOptionsOther :: Encode a => EncodeWithOptions a where 216 | encodeWithOptions _ = encode 217 | 218 | class DecodeRecord r rl | rl -> r where 219 | decodeRecordWithOptions :: RLProxy rl -> Options -> Foreign -> F (Builder {} (Record r)) 220 | 221 | class EncodeRecord r rl | rl -> r where 222 | encodeRecordWithOptions :: RLProxy rl -> Options -> Record r -> Object Foreign 223 | 224 | instance decodeRecordNil :: DecodeRecord () Nil where 225 | decodeRecordWithOptions _ _ _ = pure identity 226 | 227 | instance encodeRecordNil :: EncodeRecord () Nil where 228 | encodeRecordWithOptions _ _ _ = Object.empty 229 | 230 | instance decodeRecordCons 231 | :: ( Cons l a r_ r 232 | , DecodeRecord r_ rl_ 233 | , IsSymbol l 234 | , DecodeWithOptions a 235 | , Lacks l r_ 236 | ) 237 | => DecodeRecord r (Cons l a rl_) 238 | where 239 | decodeRecordWithOptions _ opts f = do 240 | builder <- decodeRecordWithOptions (RLProxy :: RLProxy rl_) opts f 241 | let l = reflectSymbol (SProxy :: SProxy l) 242 | l_transformed = (opts.fieldTransform l) 243 | f_ <- index f l_transformed 244 | a <- mapExcept (lmap (map (ErrorAtProperty l_transformed))) (decodeWithOptions opts f_) 245 | pure (builder >>> Builder.insert (SProxy :: SProxy l) a) 246 | 247 | instance encodeRecordCons 248 | :: ( Cons l a r_ r 249 | , EncodeRecord r_ rl_ 250 | , IsSymbol l 251 | , EncodeWithOptions a 252 | ) 253 | => EncodeRecord r (Cons l a rl_) 254 | where 255 | encodeRecordWithOptions _ opts rec = 256 | let obj = encodeRecordWithOptions (RLProxy :: RLProxy rl_) opts (unsafeCoerce rec) 257 | l = reflectSymbol (SProxy :: SProxy l) 258 | in Object.insert (opts.fieldTransform l) (encodeWithOptions opts (Record.get (SProxy :: SProxy l) rec)) obj 259 | 260 | class GenericDecode a where 261 | decodeOpts :: Options -> Foreign -> F a 262 | 263 | class GenericEncode a where 264 | encodeOpts :: Options -> a -> Foreign 265 | 266 | class GenericDecodeArgs a where 267 | decodeArgs :: Options -> Int -> List Foreign -> F { result :: a 268 | , rest :: List Foreign 269 | , next :: Int 270 | } 271 | 272 | class GenericEncodeArgs a where 273 | encodeArgs :: Options -> a -> List Foreign 274 | 275 | class GenericCountArgs a where 276 | countArgs :: Proxy a -> Either a Int 277 | 278 | instance genericDecodeNoConstructors :: GenericDecode NoConstructors where 279 | decodeOpts opts _ = fail (ForeignError "No constructors") 280 | 281 | instance genericEncodeNoConstructors :: GenericEncode NoConstructors where 282 | encodeOpts opts a = encodeOpts opts a 283 | 284 | instance genericDecodeConstructor 285 | :: (IsSymbol name, GenericDecodeArgs rep, GenericCountArgs rep) 286 | => GenericDecode (Constructor name rep) where 287 | decodeOpts opts f = 288 | if opts.unwrapSingleConstructors 289 | then Constructor <$> readArguments f 290 | else case opts.sumEncoding of 291 | TaggedObject { tagFieldName, contentsFieldName, constructorTagTransform } -> do 292 | tag <- mapExcept (lmap (map (ErrorAtProperty tagFieldName))) do 293 | tag <- index f tagFieldName >>= readString 294 | let expected = constructorTagTransform ctorName 295 | unless (tag == expected) $ 296 | fail (ForeignError ("Expected " <> show expected <> " tag")) 297 | pure tag 298 | args <- mapExcept (lmap (map (ErrorAtProperty contentsFieldName))) 299 | (index f contentsFieldName >>= readArguments) 300 | pure (Constructor args) 301 | where 302 | ctorName = reflectSymbol (SProxy :: SProxy name) 303 | 304 | numArgs = countArgs (Proxy :: Proxy rep) 305 | 306 | readArguments args = 307 | case numArgs of 308 | Left a -> pure a 309 | Right 1 | opts.unwrapSingleArguments -> do 310 | { result, rest } <- decodeArgs opts 0 (List.singleton args) 311 | unless (List.null rest) $ 312 | fail (ForeignError "Expected a single argument") 313 | pure result 314 | Right n -> do 315 | vals <- readArray args 316 | { result, rest } <- decodeArgs opts 0 (List.fromFoldable vals) 317 | unless (List.null rest) $ 318 | fail (ForeignError ("Expected " <> show n <> " constructor arguments")) 319 | pure result 320 | 321 | instance genericEncodeConstructor 322 | :: (IsSymbol name, GenericEncodeArgs rep) 323 | => GenericEncode (Constructor name rep) where 324 | encodeOpts opts (Constructor args) = 325 | if opts.unwrapSingleConstructors 326 | then maybe (unsafeToForeign {}) unsafeToForeign (encodeArgsArray args) 327 | else case opts.sumEncoding of 328 | TaggedObject { tagFieldName, contentsFieldName, constructorTagTransform } -> 329 | unsafeToForeign (Object.singleton tagFieldName (unsafeToForeign $ constructorTagTransform ctorName) 330 | `Object.union` maybe Object.empty (Object.singleton contentsFieldName) (encodeArgsArray args)) 331 | where 332 | ctorName = reflectSymbol (SProxy :: SProxy name) 333 | 334 | encodeArgsArray :: rep -> Maybe Foreign 335 | encodeArgsArray = unwrapArguments <<< List.toUnfoldable <<< encodeArgs opts 336 | 337 | unwrapArguments :: Array Foreign -> Maybe Foreign 338 | unwrapArguments [] = Nothing 339 | unwrapArguments [x] | opts.unwrapSingleArguments = Just x 340 | unwrapArguments xs = Just (unsafeToForeign xs) 341 | 342 | instance genericDecodeSum 343 | :: (GenericDecode a, GenericDecode b) 344 | => GenericDecode (Sum a b) where 345 | decodeOpts opts f = Inl <$> decodeOpts opts' f <|> Inr <$> decodeOpts opts' f 346 | where 347 | -- Reuse the unwrapSingleConstructors flag, since we cannot have a single 348 | -- constructor at this point anyway. 349 | opts' = opts { unwrapSingleConstructors = false } 350 | 351 | instance genericEncodeSum 352 | :: (GenericEncode a, GenericEncode b) 353 | => GenericEncode (Sum a b) where 354 | encodeOpts opts (Inl a) = encodeOpts (opts { unwrapSingleConstructors = false }) a 355 | encodeOpts opts (Inr b) = encodeOpts (opts { unwrapSingleConstructors = false }) b 356 | 357 | instance genericDecodeArgsNoArguments :: GenericDecodeArgs NoArguments where 358 | decodeArgs _ i Nil = pure { result: NoArguments, rest: Nil, next: i } 359 | decodeArgs _ _ _ = fail (ForeignError "Too many constructor arguments") 360 | 361 | instance genericEncodeArgsNoArguments :: GenericEncodeArgs NoArguments where 362 | encodeArgs _ = mempty 363 | 364 | instance genericDecodeArgsArgument 365 | :: DecodeWithOptions a 366 | => GenericDecodeArgs (Argument a) where 367 | decodeArgs opts i (x : xs) = do 368 | a <- mapExcept (lmap (map (ErrorAtIndex i))) (decodeWithOptions opts x) 369 | pure { result: Argument a, rest: xs, next: i + 1 } 370 | decodeArgs _ _ _ = fail (ForeignError "Not enough constructor arguments") 371 | 372 | instance genericEncodeArgsArgument 373 | :: EncodeWithOptions a 374 | => GenericEncodeArgs (Argument a) where 375 | encodeArgs opts (Argument a) = List.singleton (encodeWithOptions opts a) 376 | 377 | instance genericDecodeArgsProduct 378 | :: (GenericDecodeArgs a, GenericDecodeArgs b) 379 | => GenericDecodeArgs (Product a b) where 380 | decodeArgs opts i xs = do 381 | { result: resA, rest: xs1, next: i1 } <- decodeArgs opts i xs 382 | { result: resB, rest, next } <- decodeArgs opts i1 xs1 383 | pure { result: Product resA resB, rest, next } 384 | 385 | instance genericEncodeArgsProduct 386 | :: (GenericEncodeArgs a, GenericEncodeArgs b) 387 | => GenericEncodeArgs (Product a b) where 388 | encodeArgs opts (Product a b) = encodeArgs opts a <> encodeArgs opts b 389 | 390 | instance genericCountArgsNoArguments :: GenericCountArgs NoArguments where 391 | countArgs _ = Left NoArguments 392 | 393 | instance genericCountArgsArgument :: GenericCountArgs (Argument a) where 394 | countArgs _ = Right 1 395 | 396 | instance genericCountArgsProduct 397 | :: (GenericCountArgs a, GenericCountArgs b) 398 | => GenericCountArgs (Product a b) where 399 | countArgs _ = 400 | case countArgs (Proxy :: Proxy a), countArgs (Proxy :: Proxy b) of 401 | Left a , Left b -> Left (Product a b) 402 | Left _ , Right n -> Right n 403 | Right n, Left _ -> Right n 404 | Right n, Right m -> Right (n + m) 405 | --------------------------------------------------------------------------------