Merge pull request #4 from purescript/updates

Various updates

.tidyrc.json

@@ -1,4 +1,6 @@
 {
+  "importSort": "ide",
+  "importWrap": "source",
   "indent": 2,
   "operatorsFile": null,
   "ribbon": 1,

src/JSON.purs

@@ -27,10 +27,10 @@ import Prelude
 
 import Data.Either (Either(..))
 import Data.Function.Uncurried (runFn2, runFn3, runFn7)
-import Data.Maybe (Maybe(..))
 import Data.Int as Int
-import JSON.Internal (JArray, JObject, JSON) as Exports
+import Data.Maybe (Maybe(..))
 import JSON.Internal (JArray, JObject, JSON)
+import JSON.Internal (JArray, JObject, JSON) as Exports
 import JSON.Internal as Internal
 
 -- | Attempts to parse a string as a JSON value. If parsing fails, an error message detailing the
@@ -122,7 +122,7 @@ toNumber :: JSON -> Maybe Number
 toNumber json = runFn7 Internal._case fail fail Just fail fail fail json
 
 -- | Converts a `JSON` `Number` into an `Int`.
--- | 
+-- |
 -- | This is provided for convenience only.
 toInt :: JSON -> Maybe Int
 toInt = toNumber >=> Int.fromNumber

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, toArray, fromArray)
-import JSON.Internal (JArray, toArray, fromArray) as Exports
+import JSON.Internal (JArray, JSON, _index, fromArray, toArray)
+import JSON.Internal (JArray, empty, fromArray, length, 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

src/JSON/Object.purs

@@ -21,8 +21,8 @@ import Data.Function.Uncurried (runFn2, runFn3, runFn4)
 import Data.Maybe (Maybe(..))
 import Data.Tuple (Tuple(..), fst, snd)
 import Data.Unfoldable (class Unfoldable)
-import JSON.Internal (JSON, JObject, _delete, _entries, _fromEntries, _insert, _lookup)
 import JSON.Internal (JObject) as Exports
+import JSON.Internal (JObject, JSON, _delete, _entries, _fromEntries, _insert, _lookup)
 
 -- | Creates an `JObject` from an array of key/value pairs.
 fromEntries :: Array (Tuple String JSON) -> JObject

src/JSON/Path.purs

@@ -0,0 +1,39 @@
+module JSON.Path where
+
+import Prelude
+
+import Data.Maybe (Maybe(..))
+import JSON (JSON)
+import JSON as JSON
+import JSON.Array as JArray
+import JSON.Object as JObject
+
+data Path
+  = Top
+  | AtKey String Path
+  | AtIndex Int Path
+
+derive instance Eq Path
+derive instance Ord Path
+
+instance Show Path where
+  show = case _ of
+    Top -> "Top"
+    AtKey key rest -> "(AtKey " <> show key <> " " <> show rest <> ")"
+    AtIndex ix rest -> "(AtIndex " <> show ix <> " " <> show rest <> ")"
+
+get :: Path -> JSON -> Maybe JSON
+get path json =
+  case path of
+    Top -> Just json
+    AtKey key rest -> JObject.lookup key =<< JSON.toJObject =<< get rest json
+    AtIndex ix rest -> JArray.index ix =<< JSON.toJArray =<< get rest json
+
+print :: Path -> String
+print path = "$" <> go path ""
+  where
+  go :: Path -> String -> String
+  go p acc = case p of
+    Top -> acc
+    AtKey k rest -> go rest ("." <> k <> acc)
+    AtIndex ix rest -> go rest ("[" <> show ix <> "]" <> acc)

test/Main.purs

@@ -2,13 +2,15 @@ module Test.Main where
 
 import Prelude
 
+import Data.Maybe (Maybe(..))
 import Data.Tuple (Tuple(..))
 import Effect (Effect)
 import Effect.Console (log)
 import JSON as J
 import JSON.Array as JA
 import JSON.Object as JO
-import Test.Assert (assertTrue)
+import JSON.Path as Path
+import Test.Assert (assertEqual, assertTrue)
 
 main :: Effect Unit
 main = do
@@ -25,10 +27,37 @@ 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 ])
+
+  log "Check path printing"
+  assertEqual
+    { expected: "$.data[0].field"
+    , actual: Path.print (Path.AtKey "field" (Path.AtIndex 0 (Path.AtKey "data" Path.Top)))
+    }
+
+  log "Check path get"
+  assertTrue $ Path.get Path.Top (J.fromString "hello") == Just (J.fromString "hello")
+  assertTrue $ Path.get Path.Top (J.fromJArray (JA.fromArray [ J.fromInt 42 ])) == Just (J.fromJArray (JA.fromArray [ J.fromInt 42 ]))
+  assertTrue $ Path.get (Path.AtIndex 0 Path.Top) (J.fromJArray (JA.fromArray [ J.fromInt 42, J.fromString "X", J.fromBoolean true ])) == Just (J.fromInt 42)
+  assertTrue $ Path.get (Path.AtIndex 1 Path.Top) (J.fromJArray (JA.fromArray [ J.fromInt 42, J.fromString "X", J.fromBoolean true ])) == Just (J.fromString "X")
+  assertTrue $ Path.get (Path.AtIndex 5 Path.Top) (J.fromJArray (JA.fromArray [ J.fromInt 42, J.fromString "X", J.fromBoolean true ])) == Nothing
+  assertTrue $ Path.get (Path.AtKey "a" Path.Top) (J.fromJObject (JO.fromEntries [ Tuple "a" (J.fromInt 1), Tuple "x" (J.fromBoolean false) ])) == Just (J.fromInt 1)
+  assertTrue $ Path.get (Path.AtKey "x" Path.Top) (J.fromJObject (JO.fromEntries [ Tuple "a" (J.fromInt 1), Tuple "x" (J.fromBoolean false) ])) == Just (J.fromBoolean false)
+  assertTrue $ Path.get (Path.AtKey "z" Path.Top) (J.fromJObject (JO.fromEntries [ Tuple "a" (J.fromInt 1), Tuple "x" (J.fromBoolean false) ])) == Nothing
+  assertTrue $ Path.get (Path.AtKey "x" (Path.AtIndex 1 Path.Top)) (J.fromJArray (JA.fromArray [ J.fromString "skip", (J.fromJObject (JO.fromEntries [ Tuple "a" (J.fromInt 1), Tuple "x" (J.fromBoolean false) ])) ])) == Just (J.fromBoolean false)