diff --git a/CHANGELOG.md b/CHANGELOG.md index 5c54948..05300ce 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,6 +8,10 @@ Breaking changes: New features: +* New module `Data.Argonaut.Custom` allows for user-defined handling of JSON + numerals. This enables avoiding IEEE 754, which does not have infinite + precision. + Bugfixes: Other improvements: diff --git a/src/Data/Argonaut/Core.js b/src/Data/Argonaut/Core.js index 3101e99..c93b3c2 100644 --- a/src/Data/Argonaut/Core.js +++ b/src/Data/Argonaut/Core.js @@ -1,15 +1,3 @@ -/* eslint-disable no-eq-null, eqeqeq */ -function id(x) { - return x; -} - -export {id as fromBoolean}; -export {id as fromNumber}; -export {id as fromString}; -export {id as fromArray}; -export {id as fromObject}; -export const jsonNull = null; - export function stringify(j) { return JSON.stringify(j); } @@ -19,84 +7,3 @@ export function stringifyWithIndent(i) { return JSON.stringify(j, null, i); }; } - -function isArray(a) { - return Object.prototype.toString.call(a) === "[object Array]"; -} - -export function _caseJson(isNull, isBool, isNum, isStr, isArr, isObj, j) { - if (j == null) return isNull(); - else if (typeof j === "boolean") return isBool(j); - else if (typeof j === "number") return isNum(j); - else if (typeof j === "string") return isStr(j); - else if (Object.prototype.toString.call(j) === "[object Array]") - return isArr(j); - else return isObj(j); -} - -export function _compare(EQ, GT, LT, a, b) { - if (a == null) { - if (b == null) return EQ; - else return LT; - } else if (typeof a === "boolean") { - if (typeof b === "boolean") { - // boolean / boolean - if (a === b) return EQ; - else if (a === false) return LT; - else return GT; - } else if (b == null) return GT; - else return LT; - } else if (typeof a === "number") { - if (typeof b === "number") { - if (a === b) return EQ; - else if (a < b) return LT; - else return GT; - } else if (b == null) return GT; - else if (typeof b === "boolean") return GT; - else return LT; - } else if (typeof a === "string") { - if (typeof b === "string") { - if (a === b) return EQ; - else if (a < b) return LT; - else return GT; - } else if (b == null) return GT; - else if (typeof b === "boolean") return GT; - else if (typeof b === "number") return GT; - else return LT; - } else if (isArray(a)) { - if (isArray(b)) { - for (var i = 0; i < Math.min(a.length, b.length); i++) { - var ca = _compare(EQ, GT, LT, a[i], b[i]); - if (ca !== EQ) return ca; - } - if (a.length === b.length) return EQ; - else if (a.length < b.length) return LT; - else return GT; - } else if (b == null) return GT; - else if (typeof b === "boolean") return GT; - else if (typeof b === "number") return GT; - else if (typeof b === "string") return GT; - else return LT; - } else { - if (b == null) return GT; - else if (typeof b === "boolean") return GT; - else if (typeof b === "number") return GT; - else if (typeof b === "string") return GT; - else if (isArray(b)) return GT; - else { - var akeys = Object.keys(a); - var bkeys = Object.keys(b); - if (akeys.length < bkeys.length) return LT; - else if (akeys.length > bkeys.length) return GT; - var keys = akeys.concat(bkeys).sort(); - for (var j = 0; j < keys.length; j++) { - var k = keys[j]; - if (a[k] === undefined) return LT; - else if (b[k] === undefined) return GT; - var ck = _compare(EQ, GT, LT, a[k], b[k]); - if (ck !== EQ) return ck; - } - return EQ; - } - } -} diff --git a/src/Data/Argonaut/Core.purs b/src/Data/Argonaut/Core.purs index ead046a..4e37bb2 100644 --- a/src/Data/Argonaut/Core.purs +++ b/src/Data/Argonaut/Core.purs @@ -42,32 +42,14 @@ module Data.Argonaut.Core import Prelude -import Data.Function.Uncurried (Fn5, runFn5, Fn7, runFn7) -import Data.Maybe (Maybe(..)) +import Data.Maybe (Maybe) import Foreign.Object (Object) -import Foreign.Object as Obj +import Data.Argonaut.Custom as Custom -- | The type of JSON data. The underlying representation is the same as what -- | would be returned from JavaScript's `JSON.parse` function; that is, -- | ordinary JavaScript booleans, strings, arrays, objects, etc. -foreign import data Json :: Type - -instance eqJson :: Eq Json where - eq j1 j2 = compare j1 j2 == EQ - -instance ordJson :: Ord Json where - compare a b = runFn5 _compare EQ GT LT a b - --- | The type of null values inside JSON data. There is exactly one value of --- | this type: in JavaScript, it is written `null`. This module exports this --- | value as `jsonNull`. -foreign import data JNull :: Type - -instance eqJNull :: Eq JNull where - eq _ _ = true - -instance ordJNull :: Ord JNull where - compare _ _ = EQ +type Json = Custom.Json Number -- | Case analysis for `Json` values. See the README for more information. caseJson @@ -80,161 +62,154 @@ caseJson -> (Object Json -> a) -> Json -> a -caseJson a b c d e f json = runFn7 _caseJson a b c d e f json +caseJson = Custom.caseJson -- | A simpler version of `caseJson` which accepts a callback for when the -- | `Json` argument was null, and a default value for all other cases. caseJsonNull :: forall a. a -> (Unit -> a) -> Json -> a -caseJsonNull d f j = runFn7 _caseJson f (const d) (const d) (const d) (const d) (const d) j +caseJsonNull = Custom.caseJsonNull -- | A simpler version of `caseJson` which accepts a callback for when the -- | `Json` argument was a `Boolean`, and a default value for all other cases. caseJsonBoolean :: forall a. a -> (Boolean -> a) -> Json -> a -caseJsonBoolean d f j = runFn7 _caseJson (const d) f (const d) (const d) (const d) (const d) j +caseJsonBoolean = Custom.caseJsonBoolean -- | A simpler version of `caseJson` which accepts a callback for when the -- | `Json` argument was a `Number`, and a default value for all other cases. caseJsonNumber :: forall a. a -> (Number -> a) -> Json -> a -caseJsonNumber d f j = runFn7 _caseJson (const d) (const d) f (const d) (const d) (const d) j +caseJsonNumber = Custom.caseJsonNumber -- | A simpler version of `caseJson` which accepts a callback for when the -- | `Json` argument was a `String`, and a default value for all other cases. caseJsonString :: forall a. a -> (String -> a) -> Json -> a -caseJsonString d f j = runFn7 _caseJson (const d) (const d) (const d) f (const d) (const d) j +caseJsonString = Custom.caseJsonString -- | A simpler version of `caseJson` which accepts a callback for when the -- | `Json` argument was a `Array Json`, and a default value for all other cases. caseJsonArray :: forall a. a -> (Array Json -> a) -> Json -> a -caseJsonArray d f j = runFn7 _caseJson (const d) (const d) (const d) (const d) f (const d) j +caseJsonArray = Custom.caseJsonArray -- | A simpler version of `caseJson` which accepts a callback for when the -- | `Json` argument was an `Object`, and a default value for all other cases. caseJsonObject :: forall a. a -> (Object Json -> a) -> Json -> a -caseJsonObject d f j = runFn7 _caseJson (const d) (const d) (const d) (const d) (const d) f j - -verbJsonType :: forall a b. b -> (a -> b) -> (b -> (a -> b) -> Json -> b) -> Json -> b -verbJsonType def f g = g def f +caseJsonObject = Custom.caseJsonObject -- Tests -isJsonType :: forall a. (Boolean -> (a -> Boolean) -> Json -> Boolean) -> Json -> Boolean -isJsonType = verbJsonType false (const true) - -- | Check if the provided `Json` is the `null` value isNull :: Json -> Boolean -isNull = isJsonType caseJsonNull +isNull = Custom.isNull -- | Check if the provided `Json` is a `Boolean` isBoolean :: Json -> Boolean -isBoolean = isJsonType caseJsonBoolean +isBoolean = Custom.isBoolean -- | Check if the provided `Json` is a `Number` isNumber :: Json -> Boolean -isNumber = isJsonType caseJsonNumber +isNumber = Custom.isNumber -- | Check if the provided `Json` is a `String` isString :: Json -> Boolean -isString = isJsonType caseJsonString +isString = Custom.isString -- | Check if the provided `Json` is an `Array` isArray :: Json -> Boolean -isArray = isJsonType caseJsonArray +isArray = Custom.isArray -- | Check if the provided `Json` is an `Object` isObject :: Json -> Boolean -isObject = isJsonType caseJsonObject +isObject = Custom.isObject -- Decoding -toJsonType - :: forall a - . (Maybe a -> (a -> Maybe a) -> Json -> Maybe a) - -> Json - -> Maybe a -toJsonType = verbJsonType Nothing Just - -- | Convert `Json` to the `Unit` value if the `Json` is the null value toNull :: Json -> Maybe Unit -toNull = toJsonType caseJsonNull +toNull = Custom.toNull -- | Convert `Json` to a `Boolean` value, if the `Json` is a boolean. toBoolean :: Json -> Maybe Boolean -toBoolean = toJsonType caseJsonBoolean +toBoolean = Custom.toBoolean -- | Convert `Json` to a `Number` value, if the `Json` is a number. toNumber :: Json -> Maybe Number -toNumber = toJsonType caseJsonNumber +toNumber = Custom.toNumber -- | Convert `Json` to a `String` value, if the `Json` is a string. To write a -- | `Json` value to a JSON string, see `stringify`. toString :: Json -> Maybe String -toString = toJsonType caseJsonString +toString = Custom.toString -- | Convert `Json` to an `Array` of `Json` values, if the `Json` is an array. toArray :: Json -> Maybe (Array Json) -toArray = toJsonType caseJsonArray +toArray = Custom.toArray -- | Convert `Json` to an `Object` of `Json` values, if the `Json` is an object. toObject :: Json -> Maybe (Object Json) -toObject = toJsonType caseJsonObject +toObject = Custom.toObject -- Encoding -- | Construct `Json` from a `Boolean` value -foreign import fromBoolean :: Boolean -> Json +fromBoolean :: Boolean -> Json +fromBoolean = Custom.fromBoolean -- | Construct `Json` from a `Number` value -foreign import fromNumber :: Number -> Json +fromNumber :: Number -> Json +fromNumber = Custom.fromNumber -- | Construct the `Json` representation of a `String` value. -- | Note that this function only produces `Json` containing a single piece of `String` -- | data (similar to `fromBoolean`, `fromNumber`, etc.). -- | This function does NOT convert the `String` encoding of a JSON value to `Json` - For that -- | purpose, you'll need to use `jsonParser`. -foreign import fromString :: String -> Json +fromString :: String -> Json +fromString = Custom.fromString -- | Construct `Json` from an array of `Json` values -foreign import fromArray :: Array Json -> Json +fromArray :: Array Json -> Json +fromArray = Custom.fromArray -- | Construct `Json` from an object with `Json` values -foreign import fromObject :: Object Json -> Json +fromObject :: Object Json -> Json +fromObject = Custom.fromObject -- Defaults -- | The JSON null value represented as `Json` -foreign import jsonNull :: Json +jsonNull :: Json +jsonNull = Custom.jsonNull -- | The true boolean value represented as `Json` jsonTrue :: Json -jsonTrue = fromBoolean true +jsonTrue = Custom.jsonTrue -- | The false boolean value represented as `Json` jsonFalse :: Json -jsonFalse = fromBoolean false +jsonFalse = Custom.jsonFalse -- | The number zero represented as `Json` jsonZero :: Json -jsonZero = fromNumber 0.0 +jsonZero = Custom.fromNumber 0.0 -- | An empty string represented as `Json` jsonEmptyString :: Json -jsonEmptyString = fromString "" +jsonEmptyString = Custom.jsonEmptyString -- | An empty array represented as `Json` jsonEmptyArray :: Json -jsonEmptyArray = fromArray [] +jsonEmptyArray = Custom.jsonEmptyArray -- | An empty object represented as `Json` jsonEmptyObject :: Json -jsonEmptyObject = fromObject Obj.empty +jsonEmptyObject = Custom.jsonEmptyObject -- | Constructs a `Json` array value containing only the provided value jsonSingletonArray :: Json -> Json -jsonSingletonArray j = fromArray [ j ] +jsonSingletonArray = Custom.jsonSingletonArray -- | Constructs a `Json` object value containing only the provided key and value jsonSingletonObject :: String -> Json -> Json -jsonSingletonObject key val = fromObject (Obj.singleton key val) +jsonSingletonObject = Custom.jsonSingletonObject -- | Converts a `Json` value to a JSON string. To retrieve a string from a `Json` -- | string value, see `fromString`. @@ -244,17 +219,3 @@ foreign import stringify :: Json -> String -- | The first `Int` argument specifies the amount of white space characters to use as indentation. -- | This number is capped at 10 (if it is greater, the value is just 10). Values less than 1 indicate that no space should be used. foreign import stringifyWithIndent :: Int -> Json -> String - -foreign import _caseJson - :: forall z - . Fn7 - (Unit -> z) - (Boolean -> z) - (Number -> z) - (String -> z) - (Array Json -> z) - (Object Json -> z) - Json - z - -foreign import _compare :: Fn5 Ordering Ordering Ordering Json Json Ordering diff --git a/src/Data/Argonaut/Custom.js b/src/Data/Argonaut/Custom.js new file mode 100644 index 0000000..98ee132 --- /dev/null +++ b/src/Data/Argonaut/Custom.js @@ -0,0 +1,159 @@ +/* eslint-disable no-eq-null, eqeqeq */ +function id(x) { + return x; +} + +export {id as fromBoolean}; +export {id as fromNumber}; +export {id as fromString}; +export {id as fromArray}; +export {id as fromObject}; +export const jsonNull = null; + +class CustomNumber { + // This tag is the point of the class + // It allows us to distinguish the custom type from regular objects in JSON + get [Symbol.toStringTag]() { + return "Data.Argonaut.Parser.CustomNumber"; + } + constructor(wrapped) { + this.wrapped = wrapped; + } +} + +export function customNumberContent(customNumber) { + return customNumber.wrapped; +} + +export function mkCustomNumber(wrapped) { + return new CustomNumber(wrapped); +} + +function isNumber(a) { + return (((typeof a) === "number") + || Object.prototype.toString.call(a) + === "[object Data.Argonaut.Parser.CustomNumber]"); +} + +function mkReplacer(encodeNumber) { + return function(key, value) { + if (isNumber(value)) { + return JSON.rawJSON(encodeNumber(value)); + } else { + return value; + } + }; +} + +export function _stringify(left) { + return function (right) { + return function (encodeNumber) { + return function (j) { + try { + return right(JSON.stringify(j, mkReplacer(encodeNumber))); + } catch (e) { + // rawJSON can throw when passed invalid JSON + return left(e.message); + } + }; + }; + }; +} + +export function _stringifyWithIndent(left) { + return function (right) { + return function (encodeNumber) { + return function (indent) { + return function (j) { + try { + return right(JSON.stringify(j, mkReplacer(left, right, encodeNumber), indent)); + } catch (e) { + return left(e.message); + } + }; + }; + }; + }; +} + +function isArray(a) { + return Object.prototype.toString.call(a) === "[object Array]"; +} + +function isObject(a) { + return Object.prototype.toString.call(a) === "[object Object]"; +} + +export function _caseJson(isNull, isBool, isNum, isStr, isArr, isObj, j) { + if (j == null) return isNull(); + else if (typeof j === "boolean") return isBool(j); + else if (isNumber(j)) return isNum(j); + else if (typeof j === "string") return isStr(j); + else if (isArray(j)) return isArr(j); + else return isObj(j); +} + +export function _compare(EQ, GT, LT, a, b, compareNumber) { + if (a == null) { + if (b == null) return EQ; + else return LT; + } else if (typeof a === "boolean") { + if (typeof b === "boolean") { + // boolean / boolean + if (a === b) return EQ; + else if (a === false) return LT; + else return GT; + } else if (b == null) return GT; + else return LT; + } else if (isNumber(a)) { + if (isNumber(b)) { + return compareNumber(a, b); + } else if (b == null) return GT; + else if (typeof b === "boolean") return GT; + else return LT; + } else if (typeof a === "string") { + if (typeof b === "string") { + if (a === b) return EQ; + else if (a < b) return LT; + else return GT; + } else if (b == null) return GT; + else if (typeof b === "boolean") return GT; + else if (isNumber(b)) return GT; + else return LT; + } else if (isArray(a)) { + if (isArray(b)) { + for (var i = 0; i < Math.min(a.length, b.length); i++) { + var ca = _compare(EQ, GT, LT, a[i], b[i], compareNumber); + if (ca !== EQ) return ca; + } + if (a.length === b.length) return EQ; + else if (a.length < b.length) return LT; + else return GT; + } else if (b == null) return GT; + else if (typeof b === "boolean") return GT; + else if (isNumber(b)) return GT; + else if (typeof b === "string") return GT; + else return LT; + } else { + if (b == null) return GT; + else if (typeof b === "boolean") return GT; + else if (isNumber(b)) return GT; + else if (typeof b === "string") return GT; + else if (isArray(b)) return GT; + else { + var akeys = Object.keys(a); + var bkeys = Object.keys(b); + if (akeys.length < bkeys.length) return LT; + else if (akeys.length > bkeys.length) return GT; + var keys = akeys.concat(bkeys).sort(); + for (var j = 0; j < keys.length; j++) { + var k = keys[j]; + if (a[k] === undefined) return LT; + else if (b[k] === undefined) return GT; + var ck = _compare(EQ, GT, LT, a[k], b[k], compareNumber); + if (ck !== EQ) return ck; + } + return EQ; + } + } +} diff --git a/src/Data/Argonaut/Custom.purs b/src/Data/Argonaut/Custom.purs new file mode 100644 index 0000000..bd9b403 --- /dev/null +++ b/src/Data/Argonaut/Custom.purs @@ -0,0 +1,302 @@ +module Data.Argonaut.Custom + ( Json + , caseJson + , caseJsonNull + , caseJsonBoolean + , caseJsonNumber + , caseJsonString + , caseJsonArray + , caseJsonObject + , isNull + , isBoolean + , isNumber + , isString + , isArray + , isObject + , fromBoolean + , fromNumber + , fromString + , fromArray + , fromObject + , toNull + , toBoolean + , toNumber + , toString + , toArray + , toObject + , jsonNull + , jsonTrue + , jsonFalse + , jsonEmptyString + , jsonEmptyArray + , jsonSingletonArray + , jsonEmptyObject + , jsonSingletonObject + , stringify + , stringifyWithIndent + , CustomNumber + , customNumberContent + , mkCustomNumber + ) where + +import Prelude + +import Data.Function.Uncurried (Fn2, Fn6, Fn7, mkFn2, runFn6, runFn7) +import Data.Either (Either(..)) +import Data.Maybe (Maybe(..)) +import Foreign.Object (Object) +import Foreign.Object as Obj + +foreign import data CustomNumber :: Type -> Type + +instance Eq a => Eq (CustomNumber a) where + eq cna cnb = customNumberContent cna `eq` customNumberContent cnb + +instance Ord a => Ord (CustomNumber a) where + compare cna cnb = customNumberContent cna `compare` customNumberContent cnb + +instance Show a => Show (CustomNumber a) where + show a = "CustomNumber " <> show (customNumberContent a) + +foreign import customNumberContent :: forall number. CustomNumber number -> number +foreign import mkCustomNumber :: forall number. number -> CustomNumber number + +-- | The type of JSON data. The underlying representation is the same as what +-- | would be returned from JavaScript's `JSON.parse` function, but numeric +-- | literals are parsed using the function given to customJsonParser. +-- | See the `Core` module for a simpler version with IEEE 754 Numbers. +foreign import data Json :: Type -> Type + +instance Ord a => Eq (Json a) where + eq j1 j2 = compare j1 j2 == EQ + +instance Ord a => Ord (Json a) where + compare a b = runFn6 _compare EQ GT LT a b (mkFn2 compare) + +-- | The type of null values inside JSON data. There is exactly one value of +-- | this type: in JavaScript, it is written `null`. This module exports this +-- | value as `jsonNull`. +foreign import data JNull :: Type + +instance eqJNull :: Eq JNull where + eq _ _ = true + +instance ordJNull :: Ord JNull where + compare _ _ = EQ + +-- | Case analysis for `Json` values. +caseJson + :: forall a number + . (Unit -> a) + -> (Boolean -> a) + -> (number -> a) + -> (String -> a) + -> (Array (Json number) -> a) + -> (Object (Json number) -> a) + -> Json number + -> a +caseJson a b c d e f json = runFn7 _caseJson a b c d e f json + +-- | A simpler version of `caseJson` which accepts a callback for when the +-- | `Json` argument was null, and a default value for all other cases. +caseJsonNull :: forall a number. a -> (Unit -> a) -> Json number -> a +caseJsonNull d f j = runFn7 _caseJson f (const d) (const d) (const d) (const d) (const d) j + +-- | A simpler version of `caseJson` which accepts a callback for when the +-- | `Json` argument was a `Boolean`, and a default value for all other cases. +caseJsonBoolean :: forall a number. a -> (Boolean -> a) -> Json number -> a +caseJsonBoolean d f j = runFn7 _caseJson (const d) f (const d) (const d) (const d) (const d) j + +-- | A simpler version of `caseJson` which accepts a callback for when the +-- | `Json` argument was a `number`, and a default value for all other cases. +caseJsonNumber :: forall a number. a -> (number -> a) -> Json number -> a +caseJsonNumber d f j = runFn7 _caseJson (const d) (const d) f (const d) (const d) (const d) j + +-- | A simpler version of `caseJson` which accepts a callback for when the +-- | `Json` argument was a `String`, and a default value for all other cases. +caseJsonString :: forall a number. a -> (String -> a) -> Json number -> a +caseJsonString d f j = runFn7 _caseJson (const d) (const d) (const d) f (const d) (const d) j + +-- | A simpler version of `caseJson` which accepts a callback for when the +-- | `Json` argument was a `Array Json`, and a default value for all other cases. +caseJsonArray :: forall a number. a -> (Array (Json number) -> a) -> Json number -> a +caseJsonArray d f j = runFn7 _caseJson (const d) (const d) (const d) (const d) f (const d) j + +-- | A simpler version of `caseJson` which accepts a callback for when the +-- | `Json` argument was an `Object`, and a default value for all other cases. +caseJsonObject :: forall a number. a -> (Object (Json number) -> a) -> Json number -> a +caseJsonObject d f j = runFn7 _caseJson (const d) (const d) (const d) (const d) (const d) f j + +verbJsonType :: forall a b number. b -> (a -> b) -> (b -> (a -> b) -> Json number -> b) -> Json number -> b +verbJsonType def f g = g def f + +-- Tests + +isJsonType :: forall a number. (Boolean -> (a -> Boolean) -> Json number -> Boolean) -> Json number -> Boolean +isJsonType = verbJsonType false (const true) + +-- | Check if the provided `Json` is the `null` value +isNull :: forall number. Json number -> Boolean +isNull = isJsonType caseJsonNull + +-- | Check if the provided `Json` is a `Boolean` +isBoolean :: forall number. Json number -> Boolean +isBoolean = isJsonType caseJsonBoolean + +-- | Check if the provided `Json` is a `Number` +isNumber :: forall number. Json number -> Boolean +isNumber = isJsonType caseJsonNumber + +-- | Check if the provided `Json` is a `String` +isString :: forall number. Json number -> Boolean +isString = isJsonType caseJsonString + +-- | Check if the provided `Json` is an `Array` +isArray :: forall number. Json number -> Boolean +isArray = isJsonType caseJsonArray + +-- | Check if the provided `Json` is an `Object` +isObject :: forall number. Json number -> Boolean +isObject = isJsonType caseJsonObject + +-- Decoding + +toJsonType + :: forall a number + . (Maybe a -> (a -> Maybe a) -> Json number -> Maybe a) + -> Json number + -> Maybe a +toJsonType = verbJsonType Nothing Just + +-- | Convert `Json` to the `Unit` value if the `Json` is the null value +toNull :: forall number. Json number -> Maybe Unit +toNull = toJsonType caseJsonNull + +-- | Convert `Json` to a `Boolean` value, if the `Json` is a boolean. +toBoolean :: forall number. Json number -> Maybe Boolean +toBoolean = toJsonType caseJsonBoolean + +-- | Convert `Json` to a `Number` value, if the `Json` is a number. +toNumber :: forall number. Json number -> Maybe number +toNumber = toJsonType caseJsonNumber + +-- | Convert `Json` to a `String` value, if the `Json` is a string. To write a +-- | `Json` value to a JSON string, see `stringify`. +toString :: forall number. Json number -> Maybe String +toString = toJsonType caseJsonString + +-- | Convert `Json` to an `Array` of `Json` values, if the `Json` is an array. +toArray :: forall number. Json number -> Maybe (Array (Json number)) +toArray = toJsonType caseJsonArray + +-- | Convert `Json` to an `Object` of `Json` values, if the `Json` is an object. +toObject :: forall number. Json number -> Maybe (Object (Json number)) +toObject = toJsonType caseJsonObject + +-- Encoding + +-- | Construct `Json` from a `Boolean` value +foreign import fromBoolean :: forall number. Boolean -> Json number + +-- | Construct `Json` from a `Number` value +foreign import fromNumber :: forall number. number -> Json number + +-- | Construct the `Json` representation of a `String` value. Note that +-- | this function only produces `Json` containing a single piece of +-- | `String` data (similar to `fromBoolean`, `fromNumber`, etc.). This +-- | function does NOT convert the `String` encoding of a JSON value to +-- | `Json` - For that purpose, you'll need to use `jsonParser`. +foreign import fromString :: forall number. String -> Json number + +-- | Construct `Json` from an array of `Json` values +foreign import fromArray :: forall number. Array (Json number) -> Json number + +-- | Construct `Json` from an object with `Json` values +foreign import fromObject :: forall number. Object (Json number) -> Json number + +-- Defaults + +-- | The JSON null value represented as `Json` +foreign import jsonNull :: forall number. Json number + +-- | The true boolean value represented as `Json` +jsonTrue :: forall number. Json number +jsonTrue = fromBoolean true + +-- | The false boolean value represented as `Json` +jsonFalse :: forall number. Json number +jsonFalse = fromBoolean false + +-- | An empty string represented as `Json` +jsonEmptyString :: forall number. Json number +jsonEmptyString = fromString "" + +-- | An empty array represented as `Json` +jsonEmptyArray :: forall number. Json number +jsonEmptyArray = fromArray [] + +-- | An empty object represented as `Json` +jsonEmptyObject :: forall number. Json number +jsonEmptyObject = fromObject Obj.empty + +-- | Constructs a `Json` array value containing only the provided value +jsonSingletonArray :: forall number. Json number -> Json number +jsonSingletonArray j = fromArray [ j ] + +-- | Constructs a `Json` object value containing only the provided key and value +jsonSingletonObject :: forall number. String -> Json number -> Json number +jsonSingletonObject key val = fromObject (Obj.singleton key val) + +-- | Converts a `Json` value to a JSON string. To retrieve a string from +-- | a `Json` string value, see `fromString`. +stringify :: forall number + . (CustomNumber number -> String) + -> Json (CustomNumber number) + -> Either String String +stringify = _stringify Left Right + +foreign import _stringify :: forall number + . (forall a b. a -> Either a b) + -> (forall a b. b -> Either a b) + -> (CustomNumber number -> String) + -> Json (CustomNumber number) + -> Either String String + +-- | Converts a `Json` value to a JSON string. +-- | The first argument encodes the custom numeral type. It must return valid JSON. +-- | The second `Int` argument specifies the amount of white space characters to use as indentation. +-- | This number is capped at 10 (if it is greater, the value is just 10). Values less than 1 indicate that no space should be used. +stringifyWithIndent :: forall number + . (CustomNumber number -> String) + -> Int + -> Json (CustomNumber number) + -> Either String String +stringifyWithIndent = _stringifyWithIndent Left Right + +foreign import _stringifyWithIndent :: forall number + . (forall a b. a -> Either a b) + -> (forall a b. b -> Either a b) + -> (CustomNumber number -> String) + -> Int + -> Json (CustomNumber number) + -> Either String String + +foreign import _caseJson + :: forall z number + . Fn7 + (Unit -> z) + (Boolean -> z) + (number -> z) + (String -> z) + (Array (Json number) -> z) + (Object (Json number) -> z) + (Json number) + z + +foreign import _compare + :: forall number + . Fn6 Ordering Ordering Ordering + (Json number) + (Json number) + (Fn2 number number Ordering) + Ordering diff --git a/src/Data/Argonaut/Parser.js b/src/Data/Argonaut/Parser.js index 4d66cac..36e19e3 100644 --- a/src/Data/Argonaut/Parser.js +++ b/src/Data/Argonaut/Parser.js @@ -6,3 +6,30 @@ export function _jsonParser(fail, succ, s) { return fail(e.message); } } + +function mkReviver(mkNumber, isNothing, fromJust) { + return (key, value, context) => { + if (typeof context === "undefined") { + throw new Error("Reviver context not available, try upgrading your JavaScript runtime"); + } + if (!context.source) return value; + if (typeof value !== "number") { + return value; + } + const mbDecoded = mkNumber(context.source); + if (isNothing(mbDecoded)) { + throw new Error("Could not decode with custom numeral parser: " + context.source); + } else { + return fromJust(mbDecoded); + } + }; +} + +export function _customJsonParser(mkNumber, isNothing, fromJust, fail, succ, s) { + try { + return succ(JSON.parse(s, mkReviver(mkNumber, isNothing, fromJust))); + } + catch (e) { + return fail(e.message); + } +} diff --git a/src/Data/Argonaut/Parser.purs b/src/Data/Argonaut/Parser.purs index 959f382..8fcec61 100644 --- a/src/Data/Argonaut/Parser.purs +++ b/src/Data/Argonaut/Parser.purs @@ -1,11 +1,32 @@ -module Data.Argonaut.Parser (jsonParser) where +module Data.Argonaut.Parser (customJsonParser, jsonParser) where import Data.Argonaut.Core (Json) +import Data.Argonaut.Custom as Custom import Data.Either (Either(..)) -import Data.Function.Uncurried (Fn3, runFn3) +import Data.Function.Uncurried (Fn3, Fn6, runFn3, runFn6) +import Data.Maybe (Maybe, fromJust, isNothing) +import Partial.Unsafe (unsafePartial) +foreign import _customJsonParser :: forall number. + Fn6 + (String -> Maybe (Custom.CustomNumber number)) + (forall a. Maybe a -> Boolean) + (forall a. Maybe a -> a) + (forall a. String -> Either String a) + (forall a. Json -> Either a Json) + String + (Either String (Custom.Json (Custom.CustomNumber number))) foreign import _jsonParser :: forall a. Fn3 (String -> a) (Json -> a) String a +-- | The first argument should return Nothing to fail, and it will cause the +-- | whole decoder to fail +customJsonParser :: forall number + . (String -> Maybe (Custom.CustomNumber number)) + -> String + -> Either String (Custom.Json (Custom.CustomNumber number)) +customJsonParser mkNumber undecodedJson = + runFn6 _customJsonParser mkNumber isNothing (unsafePartial fromJust) Left Right undecodedJson + -- | Parse a JSON string, constructing the `Json` value described by the string. -- | To convert a string into a `Json` string, see `fromString`. jsonParser :: String -> Either String Json diff --git a/test/Test/Main.purs b/test/Test/Main.purs index 89c9344..d73d69e 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -5,13 +5,15 @@ import Prelude import Control.Monad.Gen as Gen import Data.Argonaut.Core (Json, caseJson, caseJsonArray, caseJsonBoolean, caseJsonNull, caseJsonNumber, caseJsonObject, caseJsonString, fromArray, fromBoolean, fromNumber, fromObject, fromString, isArray, isBoolean, isNull, isNumber, isObject, isString, jsonNull, stringify, toArray, toBoolean, toNull, toNumber, toObject, toString) import Data.Argonaut.Gen (genJson) -import Data.Argonaut.Parser (jsonParser) +import Data.Argonaut.Custom as Custom +import Data.Argonaut.Parser (jsonParser, customJsonParser) import Data.Array as A -import Data.Either (isLeft, Either(..)) +import Data.Either (Either(..), isLeft) import Data.Maybe (Maybe(..), fromJust) import Data.Tuple (Tuple(..)) import Effect (Effect) import Effect.Console (log) +import Effect.Exception (throwException, error) import Foreign.Object as Obj import Partial.Unsafe (unsafePartial) import Test.QuickCheck (class Testable, Result, quickCheck, quickCheck', ()) @@ -150,6 +152,28 @@ parserTest = do let parsed = jsonParser (stringify json) pure $ parsed == Right json show (stringify <$> parsed) <> " /= " <> stringify json +customJsonTest :: Effect Unit +customJsonTest = do + let + parseNumberAsString :: String -> Maybe (Custom.CustomNumber String) + parseNumberAsString = Just <<< Custom.mkCustomNumber + trivialParser :: String -> Either String (Custom.Json (Custom.CustomNumber String)) + trivialParser = customJsonParser parseNumberAsString + case trivialParser "1e100" of + Left err -> throwException $ error $ "Failed to parse: " <> err + Right success -> do + assert $ Custom.isNumber success + let enc :: Custom.CustomNumber String -> String + enc = Custom.customNumberContent + assert $ Custom.stringify enc success == Right "1e100" + assert $ isLeft $ Custom.stringify (\_ -> "invalid") success + assert $ Custom.fromNumber (Custom.mkCustomNumber "1e100") == success + assert $ Custom.fromString "1e100" /= success + let + failAlways :: String -> Maybe (Custom.CustomNumber Void) + failAlways _ = Nothing + assert $ Left "Could not decode with custom numeral parser: 1e100" == customJsonParser failAlways "1e100" + assert :: forall prop. Testable prop => prop -> Effect Unit assert = quickCheck' 1 @@ -167,3 +191,7 @@ main = do toTest log "jsonParser tests" parserTest + log "customJson tests" + log "These tests may fail on older JavaScript runtimes, like Node.js 20." + log "See https://caniuse.com/wf-json-raw" + customJsonTest