Skip to content

Commit 3d7955d

Browse files
garybgaryb
authored
Merge pull request #5 from purescript/updates
Rework `Path`, add some variations for `Gen`
2 parents c9febf5 + 072cff7 commit 3d7955d

File tree

3 files changed

+113
-31
lines changed

3 files changed

+113
-31
lines changed

‎src/JSON/Gen.purs‎

Lines changed: 22 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -23,20 +23,36 @@ genJSON = Gen.resize (min 5) $ Gen.sized genJSON'
2323
| otherwise = genLeaf
2424

2525
-- | A generator for JSON arrays containing items based on the passed generator.
26-
genArrayOf :: forall m. MonadGen m => MonadRec m => m J.JSON -> m J.JSON
27-
genArrayOf inner = J.fromJArray <<< JArray.fromArray <$> Gen.unfoldable inner
26+
genJArrayOf :: forall m. MonadGen m => MonadRec m => m J.JSON -> m J.JArray
27+
genJArrayOf inner = JArray.fromArray <$> Gen.unfoldable inner
2828

2929
-- | A generator for JSON arrays containing random items.
30+
genJArray :: forall m. MonadGen m => MonadRec m => Lazy (m J.JSON) => m J.JArray
31+
genJArray = genJArrayOf (defer \_ -> genJSON)
32+
33+
-- | A generator for JSON vaues that are arrays containing items based on the passed generator.
34+
genArrayOf :: forall m. MonadGen m => MonadRec m => m J.JSON -> m J.JSON
35+
genArrayOf inner = J.fromJArray <$> genJArrayOf inner
36+
37+
-- | A generator for JSON vaues that are arrays containing random items.
3038
genArray :: forall m. MonadGen m => MonadRec m => Lazy (m J.JSON) => m J.JSON
31-
genArray = genArrayOf (defer \_ -> genJSON)
39+
genArray = J.fromJArray <$> genJArray
3240

3341
-- | A generator for JSON objects containing entries based on the passed generator.
34-
genObjectOf :: forall m. MonadGen m => MonadRec m => m (Tuple String J.JSON) -> m J.JSON
35-
genObjectOf inner = J.fromJObject <<< JObject.fromEntries <$> (Gen.unfoldable inner)
42+
genJObjectOf :: forall m. MonadGen m => MonadRec m => m (Tuple String J.JSON) -> m J.JObject
43+
genJObjectOf inner = JObject.fromEntries <$> (Gen.unfoldable inner)
3644

3745
-- | A generator for JSON objects containing random entries.
46+
genJObject :: forall m. MonadGen m => MonadRec m => Lazy (m J.JSON) => m J.JObject
47+
genJObject = genJObjectOf (Tuple <$> genUnicodeString <*> defer \_ -> genJSON)
48+
49+
-- | A generator for JSON values that are objects containing entries based on the passed generator.
50+
genObjectOf :: forall m. MonadGen m => MonadRec m => m (Tuple String J.JSON) -> m J.JSON
51+
genObjectOf inner = J.fromJObject <$> genJObjectOf inner
52+
53+
-- | A generator for JSON values that are objects containing random entries.
3854
genObject :: forall m. MonadGen m => MonadRec m => Lazy (m J.JSON) => m J.JSON
39-
genObject = genObjectOf (Tuple <$> genUnicodeString <*> defer \_ -> genJSON)
55+
genObject = J.fromJObject <$> genJObject
4056

4157
-- | A generator for JSON leaf (null, boolean, number, string) values.
4258
genLeaf :: forall m. MonadGen m => MonadRec m => m J.JSON

‎src/JSON/Path.purs‎

Lines changed: 45 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -2,38 +2,72 @@ module JSON.Path where
22

33
import Prelude
44

5+
import Data.Generic.Rep (class Generic)
56
import Data.Maybe (Maybe(..))
67
import JSON (JSON)
78
import JSON as JSON
89
import JSON.Array as JArray
910
import JSON.Object as JObject
1011

12+
-- | A path to a location in a JSON document.
1113
data Path
12-
= Top
14+
= Tip
1315
| AtKey String Path
1416
| AtIndex Int Path
1517

1618
derive instance Eq Path
1719
derive instance Ord Path
20+
derive instance Generic Path _
1821

1922
instance Show Path where
2023
show = case _ of
21-
Top -> "Top"
24+
Tip -> "Tip"
2225
AtKey key rest -> "(AtKey " <> show key <> " " <> show rest <> ")"
2326
AtIndex ix rest -> "(AtIndex " <> show ix <> " " <> show rest <> ")"
2427

28+
-- | Attempts to get the value at the path in a JSON document.
2529
get :: Path -> JSON -> Maybe JSON
2630
get path json =
2731
case path of
28-
Top -> Just json
29-
AtKey key rest -> JObject.lookup key =<< JSON.toJObject =<< get rest json
30-
AtIndex ix rest -> JArray.index ix =<< JSON.toJArray =<< get rest json
32+
Tip -> Just json
33+
AtKey key rest -> get rest =<< JObject.lookup key =<< JSON.toJObject json
34+
AtIndex ix rest -> get rest =<< JArray.index ix =<< JSON.toJArray json
3135

36+
-- | Prints the path as a basic JSONPath expression.
3237
print :: Path -> String
33-
print path = "$" <> go path ""
38+
print path = "$" <> go path
3439
where
35-
go :: Path -> String -> String
36-
go p acc = case p of
37-
Top -> acc
38-
AtKey k rest -> go rest ("." <> k <> acc)
39-
AtIndex ix rest -> go rest ("[" <> show ix <> "]" <> acc)
40+
go :: Path -> String
41+
go p = case p of
42+
Tip -> ""
43+
AtKey k rest -> "." <> k <> go rest -- TODO: ["quoted"] paths also
44+
AtIndex ix rest -> "[" <> show ix <> "]" <> go rest
45+
46+
-- | Extends the tip of the first path with the second path.
47+
-- |
48+
-- | For example, `$.data[0]` extended with `$.info.title` would result in `$.data[0].info.title`.
49+
extend :: Path -> Path -> Path
50+
extend p1 p2 = case p1 of
51+
Tip -> p2
52+
AtKey key rest -> AtKey key (extend rest p2)
53+
AtIndex ix rest -> AtIndex ix (extend rest p2)
54+
55+
-- | Finds the common prefix of two paths. If they have nothing in common the result will be the
56+
-- | root.
57+
findCommonPrefix :: Path -> Path -> Path
58+
findCommonPrefix = case _, _ of
59+
AtKey k1 rest1, AtKey k2 rest2 | k1 == k2 -> AtKey k1 (findCommonPrefix rest1 rest2)
60+
AtIndex i1 rest1, AtIndex i2 rest2 | i1 == i2 -> AtIndex i1 (findCommonPrefix rest1 rest2)
61+
_, _ -> Tip
62+
63+
-- | Attempts to strip the first path from the start of the second path. `Nothing` is returned if
64+
-- | the second path does not start with the prefix.
65+
-- |
66+
-- | For example, stripping a prefix of `$.data[0]` from `$.data[0].info.title` would result in
67+
-- | `$.info.title`.
68+
stripPrefix :: Path -> Path -> Maybe Path
69+
stripPrefix = case _, _ of
70+
AtKey k1 rest1, AtKey k2 rest2 | k1 == k2 -> stripPrefix rest1 rest2
71+
AtIndex i1 rest1, AtIndex i2 rest2 | i1 == i2 -> stripPrefix rest1 rest2
72+
Tip, tail -> Just tail
73+
_, _ -> Nothing

‎test/Main.purs‎

Lines changed: 46 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,7 @@ import JSON as J
1010
import JSON.Array as JA
1111
import JSON.Object as JO
1212
import JSON.Path as Path
13-
import Test.Assert (assertEqual, assertTrue)
13+
import Test.Assert (assertTrue)
1414

1515
main :: Effect Unit
1616
main = do
@@ -46,18 +46,50 @@ main = do
4646
assertTrue $ JA.fromArray (J.fromInt <$> [ 1, 2 ]) <> JA.fromArray (J.fromInt <$> [ 2, 3 ]) == JA.fromArray (J.fromInt <$> [ 1, 2, 2, 3 ])
4747

4848
log "Check path printing"
49-
assertEqual
50-
{ expected: "$.data[0].field"
51-
, actual: Path.print (Path.AtKey "field" (Path.AtIndex 0 (Path.AtKey "data" Path.Top)))
52-
}
49+
assertTrue $ Path.print (Path.AtKey "data" (Path.AtIndex 0 (Path.AtKey "field" Path.Tip))) == "$.data[0].field"
5350

5451
log "Check path get"
55-
assertTrue $ Path.get Path.Top (J.fromString "hello") == Just (J.fromString "hello")
56-
assertTrue $ Path.get Path.Top (J.fromJArray (JA.fromArray [ J.fromInt 42 ])) == Just (J.fromJArray (JA.fromArray [ J.fromInt 42 ]))
57-
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)
58-
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")
59-
assertTrue $ Path.get (Path.AtIndex 5 Path.Top) (J.fromJArray (JA.fromArray [ J.fromInt 42, J.fromString "X", J.fromBoolean true ])) == Nothing
60-
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)
61-
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)
62-
assertTrue $ Path.get (Path.AtKey "z" Path.Top) (J.fromJObject (JO.fromEntries [ Tuple "a" (J.fromInt 1), Tuple "x" (J.fromBoolean false) ])) == Nothing
63-
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)
52+
assertTrue $ Path.get Path.Tip (J.fromString "hello") == Just (J.fromString "hello")
53+
assertTrue $ Path.get Path.Tip (J.fromJArray (JA.fromArray [ J.fromInt 42 ])) == Just (J.fromJArray (JA.fromArray [ J.fromInt 42 ]))
54+
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)
55+
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")
56+
assertTrue $ Path.get (Path.AtIndex 5 Path.Tip) (J.fromJArray (JA.fromArray [ J.fromInt 42, J.fromString "X", J.fromBoolean true ])) == Nothing
57+
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)
58+
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)
59+
assertTrue $ Path.get (Path.AtKey "z" Path.Tip) (J.fromJObject (JO.fromEntries [ Tuple "a" (J.fromInt 1), Tuple "x" (J.fromBoolean false) ])) == Nothing
60+
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)
61+
62+
log "Check path extend"
63+
assertTrue do
64+
let p1 = Path.AtKey "data" $ Path.AtIndex 0 $ Path.Tip
65+
let p2 = Path.AtKey "info" $ Path.AtKey "title" $ Path.Tip
66+
let expected = Path.AtKey "data" $ Path.AtIndex 0 $ Path.AtKey "info" $ Path.AtKey "title" $ Path.Tip
67+
Path.extend p1 p2 == expected
68+
69+
log "Check path findCommonPrefix"
70+
assertTrue do
71+
let p1 = Path.AtKey "y" $ Path.AtKey "x" $ Path.AtIndex 1 $ Path.Tip
72+
let p2 = Path.AtKey "y" $ Path.AtKey "x" $ Path.AtIndex 0 $ Path.Tip
73+
let expected = Path.AtKey "y" $ Path.AtKey "x" $ Path.Tip
74+
Path.findCommonPrefix p1 p2 == expected
75+
assertTrue do
76+
let p1 = Path.AtKey "other" $ Path.Tip
77+
let p2 = Path.AtKey "y" $ Path.AtKey "x" $ Path.AtIndex 0 $ Path.Tip
78+
let expected = Path.Tip
79+
Path.findCommonPrefix p1 p2 == expected
80+
81+
log "Check path stripPrefix"
82+
assertTrue do
83+
let p1 = Path.AtKey "y" Path.Tip
84+
let p2 = Path.AtKey "y" $ Path.AtKey "x" $ Path.AtIndex 0 $ Path.Tip
85+
let expected = Path.AtKey "x" $ Path.AtIndex 0 Path.Tip
86+
Path.stripPrefix p1 p2 == Just expected
87+
assertTrue do
88+
let p1 = Path.AtKey "y" $ Path.AtKey "x" $ Path.Tip
89+
let p2 = Path.AtKey "y" $ Path.AtKey "x" $ Path.AtIndex 0 Path.Tip
90+
let expected = Path.AtIndex 0 Path.Tip
91+
Path.stripPrefix p1 p2 == Just expected
92+
assertTrue do
93+
let p1 = Path.AtKey "other" Path.Tip
94+
let p2 = Path.AtKey "y" $ Path.AtKey "x" $ Path.AtIndex 0 Path.Tip
95+
Path.stripPrefix p1 p2 == Nothing

0 commit comments

Comments
 (0)