Evert Path, add more operations

`Path` works better this way for building up error paths after the fact rather than having to push them down as we go. Makes some of the new ops easier to implement too.

Author: garyb

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

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