Add user-defined numeral parsing

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:

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;
-    }
-  }
-}

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