From ad0d657ad39851ebd57ad68be810c07251c94aee Mon Sep 17 00:00:00 2001 From: Phil Freeman Date: Sat, 8 Apr 2017 12:56:39 -0700 Subject: [PATCH] Updates for 0.11 (#21) * Updates for 0.11 * Rename things, add docs * Add NullOrUndefined, refactor module and function names * Update README * Remove old docs --- .travis.yml | 8 +- LICENSE | 44 +++++++++ README.md | 59 +++++++----- bower.json | 21 +++-- docs/Data/Foreign/Generic.md | 41 --------- generated-docs/Data/Foreign/Class.md | 71 +++++++++++++++ generated-docs/Data/Foreign/Generic.md | 63 +++++++++++++ .../Data/Foreign/Generic/Class.md | 10 +- .../Data/Foreign/Generic/Types.md | 0 generated-docs/Data/Foreign/JSON.md | 17 ++++ .../Data/Foreign/NullOrUndefined.md | 40 ++++++++ package.json | 10 +- src/Data/Foreign/Class.purs | 91 +++++++++++++++++++ src/Data/Foreign/Generic.purs | 77 +++++++++++++--- .../Generic/{Classes.purs => Class.purs} | 28 +++--- src/Data/Foreign/JSON.js | 5 + src/Data/Foreign/JSON.purs | 28 ++++++ src/Data/Foreign/NullOrUndefined.purs | 30 ++++++ test/Main.purs | 15 ++- test/Types.purs | 38 ++++---- 20 files changed, 554 insertions(+), 142 deletions(-) create mode 100644 LICENSE delete mode 100644 docs/Data/Foreign/Generic.md create mode 100644 generated-docs/Data/Foreign/Class.md create mode 100644 generated-docs/Data/Foreign/Generic.md rename docs/Data/Foreign/Generic/Classes.md => generated-docs/Data/Foreign/Generic/Class.md (88%) rename {docs => generated-docs}/Data/Foreign/Generic/Types.md (100%) create mode 100644 generated-docs/Data/Foreign/JSON.md create mode 100644 generated-docs/Data/Foreign/NullOrUndefined.md create mode 100644 src/Data/Foreign/Class.purs rename src/Data/Foreign/Generic/{Classes.purs => Class.purs} (91%) create mode 100644 src/Data/Foreign/JSON.js create mode 100644 src/Data/Foreign/JSON.purs create mode 100644 src/Data/Foreign/NullOrUndefined.purs diff --git a/.travis.yml b/.travis.yml index 9d81fd5..f070348 100644 --- a/.travis.yml +++ b/.travis.yml @@ -2,17 +2,11 @@ language: node_js dist: trusty sudo: required node_js: 6 -env: - - PATH=$HOME/purescript:$PATH install: - - TAG=$(wget -q -O - https://github.com/purescript/purescript/releases/latest --server-response --max-redirect 0 2>&1 | sed -n -e 's/.*Location:.*tag\///p') - - wget -O $HOME/purescript.tar.gz https://github.com/purescript/purescript/releases/download/$TAG/linux64.tar.gz - - tar -xvf $HOME/purescript.tar.gz -C $HOME/ - - chmod a+x $HOME/purescript - npm install -g bower - npm install script: - bower install --production - npm run -s build - bower install - - npm -s test + - npm run -s test diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..846498f --- /dev/null +++ b/LICENSE @@ -0,0 +1,44 @@ +The MIT License (MIT) + +Copyright (c) 2017 Phil Freeman + + Permission is hereby granted, free of charge, to any person obtaining a copy of + this software and associated documentation files (the "Software"), to deal in + the Software without restriction, including without limitation the rights to + use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of + the Software, and to permit persons to whom the Software is furnished to do so, + subject to the following conditions: + + The above copyright notice and this permission notice shall be included in all + copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS + FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR + COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER + IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN + CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + +purescript-foreign-generic uses code taken from the purescript-foreign library, +which is used under the terms of the MIT license, below: + + The MIT License (MIT) + + Copyright (c) 2014 PureScript + + Permission is hereby granted, free of charge, to any person obtaining a copy of + this software and associated documentation files (the "Software"), to deal in + the Software without restriction, including without limitation the rights to + use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of + the Software, and to permit persons to whom the Software is furnished to do so, + subject to the following conditions: + + The above copyright notice and this permission notice shall be included in all + copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS + FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR + COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER + IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN + CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/README.md b/README.md index 312ed6c..e1cdd42 100644 --- a/README.md +++ b/README.md @@ -4,39 +4,52 @@ Generic deriving for `purescript-foreign`. -- [Module Documentation](docs/Data/Foreign/Generic.md) +- [Module Documentation](generated-docs/Data/Foreign/Generic.md) - [Example](test/Main.purs) - [Further examples in this repo](https://github.com/justinwoo/purescript-howto-foreign-generic) ## Example Usage +First, define some data type and derive `Generic`: + ```purescript -import Data.Foreign.Class (class AsForeign, class IsForeign, readJSON, write) -import Data.Foreign.Generic (defaultOptions, readGeneric, toForeignGeneric) -import Data.Generic.Rep (class Generic) -import Data.Generic.Rep.Show (genericShow) +> import Prelude +> import Data.Generic.Rep (class Generic) +> import Data.Generic.Rep.Show (genericShow) + +> newtype MyRecord = MyRecord { a :: Int } +> derive instance genericMyRecord :: Generic MyRecord _ +> instance showMyRecord :: Show MyRecord where show = genericShow +``` -newtype MyRecord = MyRecord {a :: Int} +To encode JSON, use `genericEncodeJSON`: -derive instance genericMyRecord :: Generic MyRecord _ +```purescript +> import Data.Foreign.Class (class Encode, class Decode, encode, decode) +> import Data.Foreign.Generic (defaultOptions, genericDecodeJSON, genericEncodeJSON) -instance isForeignMyRecord :: IsForeign MyRecord where - read = readGeneric $ defaultOptions {unwrapSingleConstructors = true} +> opts = defaultOptions { unwrapSingleConstructors = true } -instance asForeignMyRecord :: AsForeign MyRecord where - write = toForeignGeneric $ defaultOptions {unwrapSingleConstructors = true} +> genericEncodeJSON opts (MyRecord { a: 1 }) +"{\"a\":1}" +``` -toJSONString = write >>> unsafeStringify -fromJSONString = readJSON >>> runExcept +And to decode JSON, use `genericDecodeJSON`: -main :: forall e. Eff (console :: CONSOLE | e) Unit -main = do - log $ toJSONString (MyRecord {a: 1}) - -- {a: 1} +```purescript +> import Control.Monad.Except - log $ show eMyRecord - -- Right (MyRecord {a: 1}) - where - eMyRecord :: Either _ MyRecord - eMyRecord = fromJSONString """{"a": 1}""" -``` \ No newline at end of file +> runExcept (genericDecodeJSON opts "{\"a\":1}" :: _ MyRecord) +(Right (MyRecord { a: 1 })) +``` + +Badly formed JSON will result in a useful error, which can be inspected or pretty-printed: + +```purescript +> lmap (map renderForeignError) $ runExcept (genericDecodeJSON opts "{\"a\":\"abc\"}" :: _ MyRecord) +(Left + (NonEmptyList + (NonEmpty + "Error at array index 0: (ErrorAtProperty \"a\" (TypeMismatch \"Int\" \"String\"))" + Nil))) +``` diff --git a/bower.json b/bower.json index 25175b1..85dee42 100644 --- a/bower.json +++ b/bower.json @@ -15,17 +15,18 @@ "url": "git://github.com/paf31/purescript-foreign-generic.git" }, "dependencies": { - "purescript-console": "^2.0.0", - "purescript-eff": "^2.0.0", - "purescript-exceptions": "^2.0.0", - "purescript-foreign": "^3.0.0", - "purescript-generics-rep": "^4.0.0", - "purescript-globals": "^2.0.0", - "purescript-maps": "^2.0.0", - "purescript-nullable": "^2.0.0", - "purescript-symbols": "^2.0.0" + "purescript-console": "^3.0.0", + "purescript-eff": "^3.0.0", + "purescript-exceptions": "^3.0.0", + "purescript-foreign": "^4.0.0", + "purescript-generics-rep": "^5.0.0", + "purescript-globals": "^3.0.0", + "purescript-maps": "^3.0.0", + "purescript-nullable": "^3.0.0", + "purescript-proxy": "^2.0.0", + "purescript-symbols": "^3.0.0" }, "devDependencies": { - "purescript-assert": "^2.0.0" + "purescript-assert": "^3.0.0" } } diff --git a/docs/Data/Foreign/Generic.md b/docs/Data/Foreign/Generic.md deleted file mode 100644 index 3cd3b5e..0000000 --- a/docs/Data/Foreign/Generic.md +++ /dev/null @@ -1,41 +0,0 @@ -## Module Data.Foreign.Generic - -#### `defaultOptions` - -``` purescript -defaultOptions :: Options -``` - -#### `readGeneric` - -``` purescript -readGeneric :: forall a rep. (Generic a rep, GenericDecode rep) => Options -> Foreign -> F a -``` - -Read a value which has a `Generic` type. - -#### `toForeignGeneric` - -``` purescript -toForeignGeneric :: forall a rep. (Generic a rep, GenericEncode rep) => Options -> a -> Foreign -``` - -Generate a `Foreign` value compatible with the `readGeneric` function. - -#### `readJSONGeneric` - -``` purescript -readJSONGeneric :: forall a rep. (Generic a rep, GenericDecode rep) => Options -> String -> F a -``` - -Read a value which has a `Generic` type from a JSON String - -#### `toJSONGeneric` - -``` purescript -toJSONGeneric :: forall a rep. (Generic a rep, GenericEncode rep) => Options -> a -> String -``` - -Write a value which has a `Generic` type as a JSON String - - diff --git a/generated-docs/Data/Foreign/Class.md b/generated-docs/Data/Foreign/Class.md new file mode 100644 index 0000000..94a88e6 --- /dev/null +++ b/generated-docs/Data/Foreign/Class.md @@ -0,0 +1,71 @@ +## Module Data.Foreign.Class + +#### `Decode` + +``` purescript +class Decode a where + decode :: Foreign -> F a +``` + +The `Decode` class is used to generate decoding functions +of the form `Foreign -> F a` using `generics-rep` deriving. + +First, derive `Generic` for your data: + +```purescript +import Data.Generic.Rep + +data MyType = MyType ... + +derive instance genericMyType :: Generic MyType _ +``` + +You can then use the `genericDecode` and `genericDecodeJSON` functions +to decode your foreign/JSON-encoded data. + +##### Instances +``` purescript +Decode Foreign +Decode String +Decode Char +Decode Boolean +Decode Number +Decode Int +(Decode a) => Decode (Array a) +``` + +#### `Encode` + +``` purescript +class Encode a where + encode :: a -> Foreign +``` + +The `Encode` class is used to generate encoding functions +of the form `a -> Foreign` using `generics-rep` deriving. + +First, derive `Generic` for your data: + +```purescript +import Data.Generic.Rep + +data MyType = MyType ... + +derive instance genericMyType :: Generic MyType _ +``` + +You can then use the `genericEncode` and `genericEncodeJSON` functions +to encode your data as JSON. + +##### Instances +``` purescript +Encode Foreign +Encode String +Encode Char +Encode Boolean +Encode Number +Encode Int +(Encode a) => Encode (Array a) +``` + + diff --git a/generated-docs/Data/Foreign/Generic.md b/generated-docs/Data/Foreign/Generic.md new file mode 100644 index 0000000..12a1f5b --- /dev/null +++ b/generated-docs/Data/Foreign/Generic.md @@ -0,0 +1,63 @@ +## Module Data.Foreign.Generic + +#### `defaultOptions` + +``` purescript +defaultOptions :: Options +``` + +Default decoding/encoding options: + +- Represent sum types as records with `tag` and `contents` fields +- Unwrap single arguments +- Don't unwrap single constructors + +#### `genericDecode` + +``` purescript +genericDecode :: forall a rep. Generic a rep => GenericDecode rep => Options -> Foreign -> F a +``` + +Read a value which has a `Generic` type. + +#### `genericEncode` + +``` purescript +genericEncode :: forall a rep. Generic a rep => GenericEncode rep => Options -> a -> Foreign +``` + +Generate a `Foreign` value compatible with the `readGeneric` function. + +#### `decodeJSON` + +``` purescript +decodeJSON :: forall a. Decode a => String -> F a +``` + +Decode a JSON string using a `Decode` instance. + +#### `encodeJSON` + +``` purescript +encodeJSON :: forall a. Encode a => a -> String +``` + +Decode a JSON string using a `Decode` instance. + +#### `genericDecodeJSON` + +``` purescript +genericDecodeJSON :: forall a rep. Generic a rep => GenericDecode rep => Options -> String -> F a +``` + +Read a value which has a `Generic` type from a JSON String + +#### `genericEncodeJSON` + +``` purescript +genericEncodeJSON :: forall a rep. Generic a rep => GenericEncode rep => Options -> a -> String +``` + +Write a value which has a `Generic` type as a JSON String + + diff --git a/docs/Data/Foreign/Generic/Classes.md b/generated-docs/Data/Foreign/Generic/Class.md similarity index 88% rename from docs/Data/Foreign/Generic/Classes.md rename to generated-docs/Data/Foreign/Generic/Class.md index d606d05..ba9f5f1 100644 --- a/docs/Data/Foreign/Generic/Classes.md +++ b/generated-docs/Data/Foreign/Generic/Class.md @@ -1,4 +1,4 @@ -## Module Data.Foreign.Generic.Classes +## Module Data.Foreign.Generic.Class #### `GenericDecode` @@ -38,7 +38,7 @@ class GenericDecodeArgs a where ##### Instances ``` purescript GenericDecodeArgs NoArguments -(IsForeign a) => GenericDecodeArgs (Argument a) +(Decode a) => GenericDecodeArgs (Argument a) (GenericDecodeArgs a, GenericDecodeArgs b) => GenericDecodeArgs (Product a b) (GenericDecodeFields fields) => GenericDecodeArgs (Rec fields) ``` @@ -53,7 +53,7 @@ class GenericEncodeArgs a where ##### Instances ``` purescript GenericEncodeArgs NoArguments -(AsForeign a) => GenericEncodeArgs (Argument a) +(Encode a) => GenericEncodeArgs (Argument a) (GenericEncodeArgs a, GenericEncodeArgs b) => GenericEncodeArgs (Product a b) (GenericEncodeFields fields) => GenericEncodeArgs (Rec fields) ``` @@ -67,7 +67,7 @@ class GenericDecodeFields a where ##### Instances ``` purescript -(IsSymbol name, IsForeign a) => GenericDecodeFields (Field name a) +(IsSymbol name, Decode a) => GenericDecodeFields (Field name a) (GenericDecodeFields a, GenericDecodeFields b) => GenericDecodeFields (Product a b) ``` @@ -80,7 +80,7 @@ class GenericEncodeFields a where ##### Instances ``` purescript -(IsSymbol name, AsForeign a) => GenericEncodeFields (Field name a) +(IsSymbol name, Encode a) => GenericEncodeFields (Field name a) (GenericEncodeFields a, GenericEncodeFields b) => GenericEncodeFields (Product a b) ``` diff --git a/docs/Data/Foreign/Generic/Types.md b/generated-docs/Data/Foreign/Generic/Types.md similarity index 100% rename from docs/Data/Foreign/Generic/Types.md rename to generated-docs/Data/Foreign/Generic/Types.md diff --git a/generated-docs/Data/Foreign/JSON.md b/generated-docs/Data/Foreign/JSON.md new file mode 100644 index 0000000..531f863 --- /dev/null +++ b/generated-docs/Data/Foreign/JSON.md @@ -0,0 +1,17 @@ +## Module Data.Foreign.JSON + +#### `parseJSON` + +``` purescript +parseJSON :: String -> F Foreign +``` + +Parse a JSON string as `Foreign` data + +#### `decodeJSONWith` + +``` purescript +decodeJSONWith :: forall a. (Foreign -> F a) -> String -> F a +``` + + diff --git a/generated-docs/Data/Foreign/NullOrUndefined.md b/generated-docs/Data/Foreign/NullOrUndefined.md new file mode 100644 index 0000000..894e40e --- /dev/null +++ b/generated-docs/Data/Foreign/NullOrUndefined.md @@ -0,0 +1,40 @@ +## Module Data.Foreign.NullOrUndefined + +#### `NullOrUndefined` + +``` purescript +newtype NullOrUndefined a + = NullOrUndefined (Maybe a) +``` + +A `newtype` wrapper whose `IsForeign` instance correctly handles +null and undefined values. + +Conceptually, this type represents values which may be `null` +or `undefined`. + +##### Instances +``` purescript +Newtype (NullOrUndefined a) _ +(Eq a) => Eq (NullOrUndefined a) +(Ord a) => Ord (NullOrUndefined a) +(Show a) => Show (NullOrUndefined a) +``` + +#### `unNullOrUndefined` + +``` purescript +unNullOrUndefined :: forall a. NullOrUndefined a -> Maybe a +``` + +Unwrap a `NullOrUndefined` value + +#### `readNullOrUndefined` + +``` purescript +readNullOrUndefined :: forall a. (Foreign -> F a) -> Foreign -> F (NullOrUndefined a) +``` + +Read a `NullOrUndefined` value + + diff --git a/package.json b/package.json index 0e9f1ad..93fa370 100644 --- a/package.json +++ b/package.json @@ -1,12 +1,14 @@ { "private": true, "scripts": { - "clean": "rimraf output", - "build": "psa \"src/**/*.purs\" \"bower_components/purescript-*/src/**/*.purs\" --censor-lib --strict", - "test": "psc \"src/**/*.purs\" \"bower_components/purescript-*/src/**/*.purs\" \"test/**/*.purs\" && psc-bundle \"output/**/*.js\" --module Test.Main --main Test.Main | node" + "clean": "rimraf output && rimraf .pulp-cache", + "build": "pulp build -- --censor-lib --strict", + "test": "pulp test" }, "devDependencies": { - "purescript-psa": "^0.3.8", + "pulp": "^11.0.0", + "purescript": "^0.11.1", + "purescript-psa": "^0.5.0", "rimraf": "^2.5.0" } } diff --git a/src/Data/Foreign/Class.purs b/src/Data/Foreign/Class.purs new file mode 100644 index 0000000..feee907 --- /dev/null +++ b/src/Data/Foreign/Class.purs @@ -0,0 +1,91 @@ +module Data.Foreign.Class where + +import Prelude +import Control.Monad.Except (mapExcept) +import Data.Array ((..), zipWith, length) +import Data.Bifunctor (lmap) +import Data.Foreign (F, Foreign, ForeignError(ErrorAtIndex), readArray, readBoolean, readChar, readInt, readNumber, readString, toForeign) +import Data.Traversable (sequence) + +-- | The `Decode` class is used to generate decoding functions +-- | of the form `Foreign -> F a` using `generics-rep` deriving. +-- | +-- | First, derive `Generic` for your data: +-- | +-- | ```purescript +-- | import Data.Generic.Rep +-- | +-- | data MyType = MyType ... +-- | +-- | derive instance genericMyType :: Generic MyType _ +-- | ``` +-- | +-- | You can then use the `genericDecode` and `genericDecodeJSON` functions +-- | to decode your foreign/JSON-encoded data. +class Decode a where + decode :: Foreign -> F a + +instance foreignDecode :: Decode Foreign where + decode = pure + +instance stringDecode :: Decode String where + decode = readString + +instance charDecode :: Decode Char where + decode = readChar + +instance booleanDecode :: Decode Boolean where + decode = readBoolean + +instance numberDecode :: Decode Number where + decode = readNumber + +instance intDecode :: Decode Int where + decode = readInt + +instance arrayDecode :: Decode a => Decode (Array a) where + decode = readArray >=> readElements where + readElements :: Array Foreign -> F (Array a) + readElements arr = sequence (zipWith readElement (0 .. length arr) arr) + + readElement :: Int -> Foreign -> F a + readElement i value = mapExcept (lmap (map (ErrorAtIndex i))) (decode value) + +-- | The `Encode` class is used to generate encoding functions +-- | of the form `a -> Foreign` using `generics-rep` deriving. +-- | +-- | First, derive `Generic` for your data: +-- | +-- | ```purescript +-- | import Data.Generic.Rep +-- | +-- | data MyType = MyType ... +-- | +-- | derive instance genericMyType :: Generic MyType _ +-- | ``` +-- | +-- | You can then use the `genericEncode` and `genericEncodeJSON` functions +-- | to encode your data as JSON. +class Encode a where + encode :: a -> Foreign + +instance foreignEncode :: Encode Foreign where + encode = id + +instance stringEncode :: Encode String where + encode = toForeign + +instance charEncode :: Encode Char where + encode = toForeign + +instance booleanEncode :: Encode Boolean where + encode = toForeign + +instance numberEncode :: Encode Number where + encode = toForeign + +instance intEncode :: Encode Int where + encode = toForeign + +instance arrayEncode :: Encode a => Encode (Array a) where + encode = toForeign <<< map encode diff --git a/src/Data/Foreign/Generic.purs b/src/Data/Foreign/Generic.purs index 214395e..bb4eed0 100644 --- a/src/Data/Foreign/Generic.purs +++ b/src/Data/Foreign/Generic.purs @@ -1,12 +1,27 @@ -module Data.Foreign.Generic where +module Data.Foreign.Generic + ( defaultOptions + , genericDecode + , genericEncode + , decodeJSON + , encodeJSON + , genericDecodeJSON + , genericEncodeJSON + ) where import Prelude -import Data.Foreign (F, Foreign, parseJSON) -import Data.Foreign.Generic.Classes (class GenericDecode, class GenericEncode, decodeOpts, encodeOpts) +import Data.Foreign (F, Foreign) +import Data.Foreign.Class (class Decode, class Encode, decode, encode) +import Data.Foreign.Generic.Class (class GenericDecode, class GenericEncode, decodeOpts, encodeOpts) import Data.Foreign.Generic.Types (Options, SumEncoding(..)) +import Data.Foreign.JSON (parseJSON, decodeJSONWith) import Data.Generic.Rep (class Generic, from, to) import Global.Unsafe (unsafeStringify) +-- | Default decoding/encoding options: +-- | +-- | - Represent sum types as records with `tag` and `contents` fields +-- | - Unwrap single arguments +-- | - Don't unwrap single constructors defaultOptions :: Options defaultOptions = { sumEncoding: @@ -19,17 +34,57 @@ defaultOptions = } -- | Read a value which has a `Generic` type. -readGeneric :: forall a rep. (Generic a rep, GenericDecode rep) => Options -> Foreign -> F a -readGeneric opts = map to <<< decodeOpts opts +genericDecode + :: forall a rep + . Generic a rep + => GenericDecode rep + => Options + -> Foreign + -> F a +genericDecode opts = map to <<< decodeOpts opts -- | Generate a `Foreign` value compatible with the `readGeneric` function. -toForeignGeneric :: forall a rep. (Generic a rep, GenericEncode rep) => Options -> a -> Foreign -toForeignGeneric opts = encodeOpts opts <<< from +genericEncode + :: forall a rep + . Generic a rep + => GenericEncode rep + => Options + -> a + -> Foreign +genericEncode opts = encodeOpts opts <<< from + +-- | Decode a JSON string using a `Decode` instance. +decodeJSON + :: forall a + . Decode a + => String + -> F a +decodeJSON = decodeJSONWith decode + +-- | Decode a JSON string using a `Decode` instance. +encodeJSON + :: forall a + . Encode a + => a + -> String +encodeJSON = unsafeStringify <<< encode -- | Read a value which has a `Generic` type from a JSON String -readJSONGeneric :: forall a rep. (Generic a rep, GenericDecode rep) => Options -> String -> F a -readJSONGeneric opts = parseJSON >=> readGeneric opts +genericDecodeJSON + :: forall a rep + . Generic a rep + => GenericDecode rep + => Options + -> String + -> F a +genericDecodeJSON opts = genericDecode opts <=< parseJSON -- | Write a value which has a `Generic` type as a JSON String -toJSONGeneric :: forall a rep. (Generic a rep, GenericEncode rep) => Options -> a -> String -toJSONGeneric opts = toForeignGeneric opts >>> unsafeStringify +genericEncodeJSON + :: forall a rep + . Generic a rep + => GenericEncode rep + => Options + -> a + -> String +genericEncodeJSON opts = unsafeStringify <<< genericEncode opts diff --git a/src/Data/Foreign/Generic/Classes.purs b/src/Data/Foreign/Generic/Class.purs similarity index 91% rename from src/Data/Foreign/Generic/Classes.purs rename to src/Data/Foreign/Generic/Class.purs index 8292f73..00e9f42 100644 --- a/src/Data/Foreign/Generic/Classes.purs +++ b/src/Data/Foreign/Generic/Class.purs @@ -1,4 +1,4 @@ -module Data.Foreign.Generic.Classes where +module Data.Foreign.Generic.Class where import Prelude import Data.StrMap as S @@ -7,10 +7,10 @@ import Control.Monad.Except (mapExcept) import Data.Bifunctor (lmap) import Data.Either (Either(..)) import Data.Foreign (F, Foreign, ForeignError(..), fail, readArray, readString, toForeign) -import Data.Foreign.Class (class AsForeign, class IsForeign, read, readProp, write) +import Data.Foreign.Class (class Encode, class Decode, encode, decode) import Data.Foreign.Generic.Types (Options, SumEncoding(..)) -import Data.Foreign.Index (prop) -import Data.Generic.Rep (Argument(Argument), Constructor(Constructor), Field(Field), NoArguments(NoArguments), NoConstructors, Product(Product), Rec(Rec), Sum(Inr, Inl)) +import Data.Foreign.Index (index) +import Data.Generic.Rep (Argument(..), Constructor(..), Field(..), NoArguments(..), NoConstructors, Product(..), Rec(..), Sum(..)) import Data.List (List(..), fromFoldable, null, singleton, toUnfoldable, (:)) import Data.Maybe (Maybe(..), maybe) import Data.Monoid (mempty) @@ -56,12 +56,12 @@ instance genericDecodeConstructor else case opts.sumEncoding of TaggedObject { tagFieldName, contentsFieldName } -> do tag <- mapExcept (lmap (map (ErrorAtProperty contentsFieldName))) do - tag <- prop tagFieldName f >>= readString + tag <- index f tagFieldName >>= readString unless (tag == ctorName) $ fail (ForeignError ("Expected " <> show ctorName <> " tag")) pure tag args <- mapExcept (lmap (map (ErrorAtProperty contentsFieldName))) - (prop contentsFieldName f >>= readArguments) + (index f contentsFieldName >>= readArguments) pure (Constructor args) where ctorName = reflectSymbol (SProxy :: SProxy name) @@ -128,17 +128,17 @@ instance genericEncodeArgsNoArguments :: GenericEncodeArgs NoArguments where encodeArgs _ = mempty instance genericDecodeArgsArgument - :: IsForeign a + :: Decode a => GenericDecodeArgs (Argument a) where decodeArgs i (x : xs) = do - a <- mapExcept (lmap (map (ErrorAtIndex i))) (read x) + a <- mapExcept (lmap (map (ErrorAtIndex i))) (decode x) pure { result: Argument a, rest: xs, next: i + 1 } decodeArgs _ _ = fail (ForeignError "Not enough constructor arguments") instance genericEncodeArgsArgument - :: AsForeign a + :: Encode a => GenericEncodeArgs (Argument a) where - encodeArgs (Argument a) = singleton (write a) + encodeArgs (Argument a) = singleton (encode a) instance genericDecodeArgsProduct :: (GenericDecodeArgs a, GenericDecodeArgs b) @@ -167,19 +167,19 @@ instance genericEncodeArgsRec encodeArgs (Rec fs) = singleton (toForeign (encodeFields fs)) instance genericDecodeFieldsField - :: (IsSymbol name, IsForeign a) + :: (IsSymbol name, Decode a) => GenericDecodeFields (Field name a) where decodeFields x = do let name = reflectSymbol (SProxy :: SProxy name) -- If `name` field doesn't exist, then `y` will be `undefined`. - Field <$> readProp name x + Field <$> (index x name >>= mapExcept (lmap (map (ErrorAtProperty name))) <<< decode) instance genericEncodeFieldsField - :: (IsSymbol name, AsForeign a) + :: (IsSymbol name, Encode a) => GenericEncodeFields (Field name a) where encodeFields (Field a) = let name = reflectSymbol (SProxy :: SProxy name) - in S.singleton name (write a) + in S.singleton name (encode a) instance genericDecodeFieldsProduct :: (GenericDecodeFields a, GenericDecodeFields b) diff --git a/src/Data/Foreign/JSON.js b/src/Data/Foreign/JSON.js new file mode 100644 index 0000000..5ec76c1 --- /dev/null +++ b/src/Data/Foreign/JSON.js @@ -0,0 +1,5 @@ +"use strict"; + +exports.parseJSONImpl = function (str) { + return JSON.parse(str); +}; diff --git a/src/Data/Foreign/JSON.purs b/src/Data/Foreign/JSON.purs new file mode 100644 index 0000000..62b8bf5 --- /dev/null +++ b/src/Data/Foreign/JSON.purs @@ -0,0 +1,28 @@ +module Data.Foreign.JSON + ( parseJSON + , decodeJSONWith + ) where + +import Prelude +import Control.Monad.Eff (runPure) +import Control.Monad.Eff.Exception (EXCEPTION, message, try) +import Control.Monad.Eff.Uncurried (EffFn1, runEffFn1) +import Control.Monad.Except (ExceptT(..)) +import Data.Bifunctor (lmap) +import Data.Foreign (Foreign, ForeignError(..), F) +import Data.Identity (Identity(..)) + +foreign import parseJSONImpl :: forall eff. EffFn1 (exception :: EXCEPTION | eff) String Foreign + +-- | Parse a JSON string as `Foreign` data +parseJSON :: String -> F Foreign +parseJSON = + ExceptT + <<< Identity + <<< lmap (pure <<< JSONError <<< message) + <<< runPure + <<< try + <<< runEffFn1 parseJSONImpl + +decodeJSONWith :: forall a. (Foreign -> F a) -> String -> F a +decodeJSONWith f = f <=< parseJSON diff --git a/src/Data/Foreign/NullOrUndefined.purs b/src/Data/Foreign/NullOrUndefined.purs new file mode 100644 index 0000000..3c0a3e3 --- /dev/null +++ b/src/Data/Foreign/NullOrUndefined.purs @@ -0,0 +1,30 @@ +module Data.Foreign.NullOrUndefined where + +import Prelude + +import Data.Newtype (class Newtype, unwrap) +import Data.Maybe (Maybe(..)) +import Data.Foreign (F, Foreign, isUndefined, isNull) + +-- | A `newtype` wrapper whose `IsForeign` instance correctly handles +-- | null and undefined values. +-- | +-- | Conceptually, this type represents values which may be `null` +-- | or `undefined`. +newtype NullOrUndefined a = NullOrUndefined (Maybe a) + +derive instance newtypeNullOrUndefined :: Newtype (NullOrUndefined a) _ +derive instance eqNullOrUndefined :: Eq a => Eq (NullOrUndefined a) +derive instance ordNullOrUndefined :: Ord a => Ord (NullOrUndefined a) + +instance showNullOrUndefined :: (Show a) => Show (NullOrUndefined a) where + show x = "(NullOrUndefined " <> show (unwrap x) <> ")" + +-- | Unwrap a `NullOrUndefined` value +unNullOrUndefined :: forall a. NullOrUndefined a -> Maybe a +unNullOrUndefined (NullOrUndefined m) = m + +-- | Read a `NullOrUndefined` value +readNullOrUndefined :: forall a. (Foreign -> F a) -> Foreign -> F (NullOrUndefined a) +readNullOrUndefined _ value | isNull value || isUndefined value = pure (NullOrUndefined Nothing) +readNullOrUndefined f value = NullOrUndefined <<< Just <$> f value diff --git a/test/Main.purs b/test/Main.purs index 4b1c6db..9955331 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -6,9 +6,9 @@ import Control.Monad.Eff.Console (CONSOLE, log) import Control.Monad.Except (runExcept) import Data.Bifunctor (bimap) import Data.Either (Either(..)) -import Data.Foreign.Class (class AsForeign, class IsForeign, readJSON, write) +import Data.Foreign.Class (class Encode, class Decode) +import Data.Foreign.Generic (decodeJSON, encodeJSON) import Data.Tuple (Tuple(..)) -import Global.Unsafe (unsafeStringify) import Test.Assert (assert, assert', ASSERT) import Test.Types (IntList(..), RecordTest(..), Tree(..), TupleArray(..)) @@ -25,19 +25,18 @@ throw = flip assert' false testRoundTrip :: ∀ a eff - . ( Eq a - , IsForeign a - , AsForeign a - ) + . Eq a + => Decode a + => Encode a => a -> Eff ( console :: CONSOLE , assert :: ASSERT | eff ) Unit testRoundTrip x = do - let json = unsafeStringify (write x) + let json = encodeJSON x log json - case runExcept (readJSON json) of + case runExcept (decodeJSON json) of Right y -> assert (x == y) Left err -> throw (show err) diff --git a/test/Types.purs b/test/Types.purs index 71024e8..d8d0acb 100644 --- a/test/Types.purs +++ b/test/Types.purs @@ -3,8 +3,8 @@ module Test.Types where import Prelude import Data.Bifunctor (class Bifunctor) import Data.Foreign (ForeignError(ForeignError), fail, readArray, toForeign) -import Data.Foreign.Class (class AsForeign, class IsForeign, read, write) -import Data.Foreign.Generic (defaultOptions, readGeneric, toForeignGeneric) +import Data.Foreign.Class (class Encode, class Decode, encode, decode) +import Data.Foreign.Generic (defaultOptions, genericDecode, genericEncode) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Show (genericShow) @@ -22,15 +22,15 @@ instance showTupleArray :: (Show a, Show b) => Show (TupleArray a b) where instance eqTupleArray :: (Eq a, Eq b) => Eq (TupleArray a b) where eq x y = genericEq x y -instance isForeignTupleArray :: (IsForeign a, IsForeign b) => IsForeign (TupleArray a b) where - read x = do +instance decodeTupleArray :: (Decode a, Decode b) => Decode (TupleArray a b) where + decode x = do arr <- readArray x case arr of - [y, z] -> TupleArray <$> (Tuple <$> read y <*> read z) + [y, z] -> TupleArray <$> (Tuple <$> decode y <*> decode z) _ -> fail (ForeignError "Expected two array elements") -instance asForeignTupleArray :: (AsForeign a, AsForeign b) => AsForeign (TupleArray a b) where - write (TupleArray (Tuple a b)) = toForeign [write a, write b] +instance encodeTupleArray :: (Encode a, Encode b) => Encode (TupleArray a b) where + encode (TupleArray (Tuple a b)) = toForeign [encode a, encode b] -- | An example record newtype RecordTest = RecordTest @@ -47,11 +47,11 @@ instance showRecordTest :: Show RecordTest where instance eqRecordTest :: Eq RecordTest where eq x y = genericEq x y -instance isForeignRecordTest :: IsForeign RecordTest where - read x = readGeneric (defaultOptions { unwrapSingleConstructors = true }) x +instance decodeRecordTest :: Decode RecordTest where + decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x -instance asForeignRecordTest :: AsForeign RecordTest where - write x = toForeignGeneric (defaultOptions { unwrapSingleConstructors = true }) x +instance encodeRecordTest :: Encode RecordTest where + encode x = genericEncode (defaultOptions { unwrapSingleConstructors = true }) x -- | An example of an ADT with nullary constructors data IntList = Nil | Cons Int IntList @@ -64,11 +64,11 @@ instance showIntList :: Show IntList where instance eqIntList :: Eq IntList where eq x y = genericEq x y -instance isForeignIntList :: IsForeign IntList where - read x = readGeneric (defaultOptions { unwrapSingleConstructors = true }) x +instance decodeIntList :: Decode IntList where + decode x = genericDecode (defaultOptions { unwrapSingleConstructors = true }) x -instance asForeignIntList :: AsForeign IntList where - write x = toForeignGeneric (defaultOptions { unwrapSingleConstructors = true }) x +instance encodeIntList :: Encode IntList where + encode x = genericEncode (defaultOptions { unwrapSingleConstructors = true }) x -- | Balanced binary leaf trees data Tree a = Leaf a | Branch (Tree (TupleArray a a)) @@ -81,8 +81,8 @@ instance showTree :: Show a => Show (Tree a) where instance eqTree :: Eq a => Eq (Tree a) where eq x y = genericEq x y -instance isForeignTree :: IsForeign a => IsForeign (Tree a) where - read x = readGeneric defaultOptions x +instance decodeTree :: Decode a => Decode (Tree a) where + decode x = genericDecode defaultOptions x -instance asForeignTree :: AsForeign a => AsForeign (Tree a) where - write x = toForeignGeneric defaultOptions x +instance encodeTree :: Encode a => Encode (Tree a) where + encode x = genericEncode defaultOptions x