Implement more of JArray in the FFI

Author: garyb

src/JSON/Array.js

@@ -0,0 +1 @@
+export const singleton = (x) => [x];

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

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

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

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 ])