From c6b78b88e823d93698f024a90ee17aa6eec818bd Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Wed, 18 Oct 2023 03:26:17 +0100 Subject: [PATCH] Implement more of `JArray` in the FFI --- src/JSON/Array.js | 1 + src/JSON/Array.purs | 19 ++++++-------- src/JSON/Internal.js | 9 +++++++ src/JSON/Internal.purs | 57 +++++++++++++++++++++++++++++------------- test/Main.purs | 19 +++++++++++--- 5 files changed, 72 insertions(+), 33 deletions(-) create mode 100644 src/JSON/Array.js diff --git a/src/JSON/Array.js b/src/JSON/Array.js new file mode 100644 index 0000000..65daa4a --- /dev/null +++ b/src/JSON/Array.js @@ -0,0 +1 @@ +export const singleton = (x) => [x]; diff --git a/src/JSON/Array.purs b/src/JSON/Array.purs index 2ad461e..94eb9e1 100644 --- a/src/JSON/Array.purs +++ b/src/JSON/Array.purs @@ -1,6 +1,5 @@ module JSON.Array ( fromFoldable - , empty , singleton , index , toUnfoldable @@ -9,26 +8,22 @@ module JSON.Array import Data.Array as Array import Data.Foldable (class Foldable) -import Data.Maybe (Maybe) +import Data.Function.Uncurried (runFn4) +import Data.Maybe (Maybe(..)) import Data.Unfoldable (class Unfoldable) -import JSON.Internal (JArray, JSON, fromArray, toArray) -import JSON.Internal (JArray, fromArray, toArray) as Exports +import JSON.Internal (JArray, JSON, fromArray, toArray, _index) +import JSON.Internal (JArray, empty, length, fromArray, toArray) as Exports -- | Creates a `JArray` from a `Foldable` source of `JSON`. fromFoldable :: forall f. Foldable f => f JSON -> JArray fromFoldable js = fromArray (Array.fromFoldable js) --- | An empty `JArray`. -empty :: JArray -empty = fromArray [] - -- | Creates a `JArray` with a single entry. -singleton :: JSON -> JArray -singleton j = fromArray [ j ] +foreign import singleton :: JSON -> JArray -- | Attempts to read a value from the specified index of a `JArray`. -index :: JArray -> Int -> Maybe JSON -index js = Array.index (toArray js) +index :: Int -> JArray -> Maybe JSON +index ix arr = runFn4 _index Nothing Just ix arr -- | Unfolds a `JArray` into `JSON` items toUnfoldable :: forall f. Unfoldable f => JArray -> f JSON diff --git a/src/JSON/Internal.js b/src/JSON/Internal.js index 13eb47a..8c4e161 100644 --- a/src/JSON/Internal.js +++ b/src/JSON/Internal.js @@ -48,3 +48,12 @@ export const _entries = (tuple, obj) => export const _lookup = (nothing, just, key, obj) => hasOwnProperty.call(obj, key) ? just(obj[key]) : nothing; + +export const empty = []; + +export const length = (arr) => arr.length; + +export const _index = (nothing, just, ix, arr) => + ix >= 0 && ix < arr.length ? just(arr[ix]) : nothing; + +export const _append = (xs, ys) => xs.concat(ys); diff --git a/src/JSON/Internal.purs b/src/JSON/Internal.purs index b48ddce..503cfbc 100644 --- a/src/JSON/Internal.purs +++ b/src/JSON/Internal.purs @@ -2,9 +2,7 @@ module JSON.Internal where import Prelude -import Data.Either (Either) import Data.Function.Uncurried (Fn2, Fn3, Fn4, Fn7, runFn2, runFn7) -import Data.Maybe (Maybe) import Data.Tuple (Tuple(..)) -- | A type that represents all varieties of JSON value. @@ -54,17 +52,22 @@ foreign import toArray :: JArray -> Array JSON -- | Converts an `Array` of `JSON` values into a `JArray`. foreign import fromArray :: Array JSON -> JArray +-- | An empty `JArray`. +foreign import empty :: JArray + instance Eq JArray where - eq x y = eq (toArray x) (toArray y) + eq xs ys + | length xs == length ys = eq (toArray xs) (toArray ys) + | otherwise = false instance Ord JArray where compare x y = compare (toArray x) (toArray y) instance Semigroup JArray where - append x y = fromArray (append (toArray x) (toArray y)) + append xs ys = runFn2 _append xs ys instance Monoid JArray where - mempty = fromArray [] + mempty = empty -- | A type that represents JSON objects. Similar to the JSON type, this is not a PureScript type, -- | but represents the underlying representation for JSON objects. @@ -77,11 +80,12 @@ instance Ord JObject where compare x y = compare (runFn2 _entries Tuple x) (runFn2 _entries Tuple y) foreign import _parse - :: Fn3 - (forall a b. a -> Either a b) - (forall a b. b -> Either a b) + :: forall f + . Fn3 + (forall a b. a -> f a b) + (forall a b. b -> f a b) String - (Either String JSON) + (f String JSON) foreign import _fromNumberWithDefault :: Fn2 Int Number JSON @@ -102,18 +106,37 @@ foreign import _insert :: Fn3 String JSON JObject JObject foreign import _delete :: Fn2 String JObject JObject foreign import _fromEntries - :: Fn3 - (forall x y. Tuple x y -> x) - (forall x y. Tuple x y -> y) - (Prim.Array (Tuple String JSON)) + :: forall f + . Fn3 + (forall x y. f x y -> x) + (forall x y. f x y -> y) + (Prim.Array (f String JSON)) JObject foreign import _entries :: forall c. Fn2 (String -> JSON -> c) JObject (Prim.Array c) foreign import _lookup - :: Fn4 - (forall a. Maybe a) - (forall a. a -> Maybe a) + :: forall f + . Fn4 + (forall a. f a) + (forall a. a -> f a) String JObject - (Maybe JSON) + (f JSON) + +foreign import _index + :: forall f + . Fn4 + (forall a. f a) + (forall a. a -> f a) + Int + JArray + (f JSON) + +foreign import length :: JArray -> Int + +foreign import _append + :: Fn2 + JArray + JArray + JArray diff --git a/test/Main.purs b/test/Main.purs index 930490d..d93408f 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -2,6 +2,7 @@ module Test.Main where import Prelude +import Data.Maybe (Maybe(..)) import Data.Tuple (Tuple(..)) import Effect (Effect) import Effect.Console (log) @@ -25,10 +26,20 @@ main = do log "Check array comparisons" assertTrue $ J.fromJArray (JA.fromArray []) == J.fromJArray (JA.fromArray []) - assertTrue $ J.fromJArray (JA.fromArray [J.fromInt 1]) == J.fromJArray (JA.fromArray [J.fromInt 1]) - assertTrue $ J.fromJArray (JA.fromArray [J.fromInt 1]) < J.fromJArray (JA.fromArray [J.fromInt 2]) + assertTrue $ J.fromJArray (JA.fromArray [ J.fromInt 1 ]) == J.fromJArray (JA.fromArray [ J.fromInt 1 ]) + assertTrue $ J.fromJArray (JA.fromArray [ J.fromInt 1 ]) < J.fromJArray (JA.fromArray [ J.fromInt 2 ]) log "Check object comparisons" assertTrue $ JO.empty == JO.empty - assertTrue $ J.fromJObject (JO.fromEntries [Tuple "a" (J.fromInt 1)]) == J.fromJObject (JO.fromEntries [Tuple "a" (J.fromInt 1)]) - assertTrue $ J.fromJObject (JO.fromEntries [Tuple "a" (J.fromInt 1)]) < J.fromJObject (JO.fromEntries [Tuple "a" (J.fromInt 2)]) + assertTrue $ J.fromJObject (JO.fromEntries [ Tuple "a" (J.fromInt 1) ]) == J.fromJObject (JO.fromEntries [ Tuple "a" (J.fromInt 1) ]) + assertTrue $ J.fromJObject (JO.fromEntries [ Tuple "a" (J.fromInt 1) ]) < J.fromJObject (JO.fromEntries [ Tuple "a" (J.fromInt 2) ]) + + log "Check array index" + assertTrue $ JA.index (-1) (JA.fromArray (J.fromInt <$> [ 0, 2, 4 ])) == Nothing + assertTrue $ JA.index 0 (JA.fromArray (J.fromInt <$> [ 0, 2, 4 ])) == Just (J.fromInt 0) + assertTrue $ JA.index 1 (JA.fromArray (J.fromInt <$> [ 0, 2, 4 ])) == Just (J.fromInt 2) + assertTrue $ JA.index 2 (JA.fromArray (J.fromInt <$> [ 0, 2, 4 ])) == Just (J.fromInt 4) + assertTrue $ JA.index 3 (JA.fromArray (J.fromInt <$> [ 0, 2, 4 ])) == Nothing + + log "Check array concat" + assertTrue $ JA.fromArray (J.fromInt <$> [ 1, 2 ]) <> JA.fromArray (J.fromInt <$> [ 2, 3 ]) == JA.fromArray (J.fromInt <$> [ 1, 2, 2, 3 ])