Merge pull request #5 from purescript/updates

Rework `Path`, add some variations for `Gen`
purescript · Oct 21, 2023 · 3d7955d · 3d7955d
2 parents c9febf5 + 072cff7
commit 3d7955d
Show file tree

Hide file tree

Showing 3 changed files with 113 additions and 31 deletions.
diff --git a/src/JSON/Gen.purs b/src/JSON/Gen.purs
@@ -23,20 +23,36 @@ genJSON = Gen.resize (min 5) $ Gen.sized genJSON'
     | otherwise = genLeaf
 
 -- | A generator for JSON arrays containing items based on the passed generator.
-genArrayOf :: forall m. MonadGen m => MonadRec m => m J.JSON -> m J.JSON
-genArrayOf inner = J.fromJArray <<< JArray.fromArray <$> Gen.unfoldable inner
+genJArrayOf :: forall m. MonadGen m => MonadRec m => m J.JSON -> m J.JArray
+genJArrayOf inner = JArray.fromArray <$> Gen.unfoldable inner
 
 -- | A generator for JSON arrays containing random items.
+genJArray :: forall m. MonadGen m => MonadRec m => Lazy (m J.JSON) => m J.JArray
+genJArray = genJArrayOf (defer \_ -> genJSON)
+
+-- | A generator for JSON vaues that are arrays containing items based on the passed generator.
+genArrayOf :: forall m. MonadGen m => MonadRec m => m J.JSON -> m J.JSON
+genArrayOf inner = J.fromJArray <$> genJArrayOf inner
+
+-- | A generator for JSON vaues that are arrays containing random items.
 genArray :: forall m. MonadGen m => MonadRec m => Lazy (m J.JSON) => m J.JSON
-genArray = genArrayOf (defer \_ -> genJSON)
+genArray = J.fromJArray <$> genJArray
 
 -- | A generator for JSON objects containing entries based on the passed generator.
-genObjectOf :: forall m. MonadGen m => MonadRec m => m (Tuple String J.JSON) -> m J.JSON
-genObjectOf inner = J.fromJObject <<< JObject.fromEntries <$> (Gen.unfoldable inner)
+genJObjectOf :: forall m. MonadGen m => MonadRec m => m (Tuple String J.JSON) -> m J.JObject
+genJObjectOf inner = JObject.fromEntries <$> (Gen.unfoldable inner)
 
 -- | A generator for JSON objects containing random entries.
+genJObject :: forall m. MonadGen m => MonadRec m => Lazy (m J.JSON) => m J.JObject
+genJObject = genJObjectOf (Tuple <$> genUnicodeString <*> defer \_ -> genJSON)
+
+-- | A generator for JSON values that are objects containing entries based on the passed generator.
+genObjectOf :: forall m. MonadGen m => MonadRec m => m (Tuple String J.JSON) -> m J.JSON
+genObjectOf inner = J.fromJObject <$> genJObjectOf inner
+
+-- | A generator for JSON values that are objects containing random entries.
 genObject :: forall m. MonadGen m => MonadRec m => Lazy (m J.JSON) => m J.JSON
-genObject = genObjectOf (Tuple <$> genUnicodeString <*> defer \_ -> genJSON)
+genObject = J.fromJObject <$> genJObject
 
 -- | A generator for JSON leaf (null, boolean, number, string) values.
 genLeaf :: forall m. MonadGen m => MonadRec m => m J.JSON

diff --git a/src/JSON/Path.purs b/src/JSON/Path.purs
@@ -2,38 +2,72 @@ module JSON.Path where
 
 import Prelude
 
+import Data.Generic.Rep (class Generic)
 import Data.Maybe (Maybe(..))
 import JSON (JSON)
 import JSON as JSON
 import JSON.Array as JArray
 import JSON.Object as JObject
 
+-- | A path to a location in a JSON document.
 data Path
-  = Top
+  = Tip
   | AtKey String Path
   | AtIndex Int Path
 
 derive instance Eq Path
 derive instance Ord Path
+derive instance Generic Path _
 
 instance Show Path where
   show = case _ of
-    Top -> "Top"
+    Tip -> "Tip"
     AtKey key rest -> "(AtKey " <> show key <> " " <> show rest <> ")"
     AtIndex ix rest -> "(AtIndex " <> show ix <> " " <> show rest <> ")"
 
+-- | Attempts to get the value at the path in a JSON document.
 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
+    Tip -> Just json
+    AtKey key rest -> get rest =<< JObject.lookup key =<< JSON.toJObject json
+    AtIndex ix rest -> get rest =<< JArray.index ix =<< JSON.toJArray json
 
+-- | Prints the path as a basic JSONPath expression.
 print :: Path -> String
-print path = "$" <> go path ""
+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)
+  go :: Path -> String
+  go p = case p of
+    Tip -> ""
+    AtKey k rest -> "." <> k <> go rest -- TODO: ["quoted"] paths also
+    AtIndex ix rest -> "[" <> show ix <> "]" <> go rest
+
+-- | Extends the tip of the first path with the second path.
+-- |
+-- | For example, `$.data[0]` extended with `$.info.title` would result in `$.data[0].info.title`.
+extend :: Path -> Path -> Path
+extend p1 p2 = case p1 of
+  Tip -> p2
+  AtKey key rest -> AtKey key (extend rest p2)
+  AtIndex ix rest -> AtIndex ix (extend rest p2)
+
+-- | Finds the common prefix of two paths. If they have nothing in common the result will be the
+-- | root.
+findCommonPrefix :: Path -> Path -> Path
+findCommonPrefix = case _, _ of
+  AtKey k1 rest1, AtKey k2 rest2 | k1 == k2 -> AtKey k1 (findCommonPrefix rest1 rest2)
+  AtIndex i1 rest1, AtIndex i2 rest2 | i1 == i2 -> AtIndex i1 (findCommonPrefix rest1 rest2)
+  _, _ -> Tip
+
+-- | Attempts to strip the first path from the start of the second path. `Nothing` is returned if
+-- | the second path does not start with the prefix.
+-- |
+-- | For example, stripping a prefix of `$.data[0]` from `$.data[0].info.title` would result in
+-- | `$.info.title`.
+stripPrefix :: Path -> Path -> Maybe Path
+stripPrefix = case _, _ of
+  AtKey k1 rest1, AtKey k2 rest2 | k1 == k2 -> stripPrefix rest1 rest2
+  AtIndex i1 rest1, AtIndex i2 rest2 | i1 == i2 -> stripPrefix rest1 rest2
+  Tip, tail -> Just tail
+  _, _ -> Nothing
diff --git a/test/Main.purs b/test/Main.purs
@@ -10,7 +10,7 @@ import JSON as J
 import JSON.Array as JA
 import JSON.Object as JO
 import JSON.Path as Path
-import Test.Assert (assertEqual, assertTrue)
+import Test.Assert (assertTrue)
 
 main :: Effect Unit
 main = do
@@ -46,18 +46,50 @@ main = do
   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)))
-    }
+  assertTrue $ Path.print (Path.AtKey "data" (Path.AtIndex 0 (Path.AtKey "field" Path.Tip))) == "$.data[0].field"
 
   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)
+  assertTrue $ Path.get Path.Tip (J.fromString "hello") == Just (J.fromString "hello")
+  assertTrue $ Path.get Path.Tip (J.fromJArray (JA.fromArray [ J.fromInt 42 ])) == Just (J.fromJArray (JA.fromArray [ J.fromInt 42 ]))
+  assertTrue $ Path.get (Path.AtIndex 0 Path.Tip) (J.fromJArray (JA.fromArray [ J.fromInt 42, J.fromString "X", J.fromBoolean true ])) == Just (J.fromInt 42)
+  assertTrue $ Path.get (Path.AtIndex 1 Path.Tip) (J.fromJArray (JA.fromArray [ J.fromInt 42, J.fromString "X", J.fromBoolean true ])) == Just (J.fromString "X")
+  assertTrue $ Path.get (Path.AtIndex 5 Path.Tip) (J.fromJArray (JA.fromArray [ J.fromInt 42, J.fromString "X", J.fromBoolean true ])) == Nothing
+  assertTrue $ Path.get (Path.AtKey "a" Path.Tip) (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.Tip) (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.Tip) (J.fromJObject (JO.fromEntries [ Tuple "a" (J.fromInt 1), Tuple "x" (J.fromBoolean false) ])) == Nothing
+  assertTrue $ Path.get (Path.AtIndex 1 (Path.AtKey "x" Path.Tip)) (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)
+
+  log "Check path extend"
+  assertTrue do
+    let p1 = Path.AtKey "data" $ Path.AtIndex 0 $ Path.Tip
+    let p2 = Path.AtKey "info" $ Path.AtKey "title" $ Path.Tip
+    let expected = Path.AtKey "data" $ Path.AtIndex 0 $ Path.AtKey "info" $ Path.AtKey "title" $ Path.Tip
+    Path.extend p1 p2 == expected
+
+  log "Check path findCommonPrefix"
+  assertTrue do
+    let p1 = Path.AtKey "y" $ Path.AtKey "x" $ Path.AtIndex 1 $ Path.Tip
+    let p2 = Path.AtKey "y" $ Path.AtKey "x" $ Path.AtIndex 0 $ Path.Tip
+    let expected = Path.AtKey "y" $ Path.AtKey "x" $ Path.Tip
+    Path.findCommonPrefix p1 p2 == expected
+  assertTrue do
+    let p1 = Path.AtKey "other" $ Path.Tip
+    let p2 = Path.AtKey "y" $ Path.AtKey "x" $ Path.AtIndex 0 $ Path.Tip
+    let expected = Path.Tip
+    Path.findCommonPrefix p1 p2 == expected
+
+  log "Check path stripPrefix"
+  assertTrue do
+    let p1 = Path.AtKey "y" Path.Tip
+    let p2 = Path.AtKey "y" $ Path.AtKey "x" $ Path.AtIndex 0 $ Path.Tip
+    let expected = Path.AtKey "x" $ Path.AtIndex 0 Path.Tip
+    Path.stripPrefix p1 p2 == Just expected
+  assertTrue do
+    let p1 = Path.AtKey "y" $ Path.AtKey "x" $ Path.Tip
+    let p2 = Path.AtKey "y" $ Path.AtKey "x" $ Path.AtIndex 0 Path.Tip
+    let expected = Path.AtIndex 0 Path.Tip
+    Path.stripPrefix p1 p2 == Just expected
+  assertTrue do
+    let p1 = Path.AtKey "other" Path.Tip
+    let p2 = Path.AtKey "y" $ Path.AtKey "x" $ Path.AtIndex 0 Path.Tip
+    Path.stripPrefix p1 p2 == Nothing