Skip to content
This repository was archived by the owner on Jun 15, 2023. It is now read-only.

Commit 0cf4892

Browse files
garybgaryb
authored
Merge pull request #12 from garyb/cursor
Add a cursor for EJson
2 parents b9788c3 + b820caa commit 0cf4892

File tree

2 files changed

+210
-0
lines changed

2 files changed

+210
-0
lines changed

‎src/Data/Json/Extended/Cursor.purs

+151
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,151 @@
1+
module Data.Json.Extended.Cursor where
2+
3+
import Prelude
4+
5+
import Data.Array as A
6+
import Data.Bifunctor (lmap)
7+
import Data.Eq (class Eq1)
8+
import Data.Functor.Mu (Mu, roll, unroll)
9+
import Data.Json.Extended (EJson)
10+
import Data.Json.Extended as EJ
11+
import Data.Maybe (Maybe(..), maybe)
12+
import Data.Ord (class Ord1)
13+
import Data.Tuple (Tuple(..), lookup)
14+
15+
import Matryoshka (Algebra, cata)
16+
17+
-- | A cursor to a location in an EJson value.
18+
-- |
19+
-- | The functions operating on cursor are "depth first", that is to say:
20+
-- | ``` purescript
21+
-- | atKey (EJ.string "foo") $ atIndex 0 $ atKey (EJ.string "bar") all
22+
-- | ```
23+
-- | Is the path:
24+
-- | ```
25+
-- | <value>.bar[0].foo
26+
-- | ```
27+
type Cursor = Mu CursorF
28+
29+
all ∷ Cursor
30+
all = roll All
31+
32+
atKey ∷ EJ.EJson → Cursor → Cursor
33+
atKey k = roll <<< AtKey k
34+
35+
atIndex ∷ Int → Cursor → Cursor
36+
atIndex i = roll <<< AtIndex i
37+
38+
-- | The possible steps in a cursor.
39+
data CursorF a
40+
= All
41+
| AtKey EJson a
42+
| AtIndex Int a
43+
44+
derive instance functorCursorF ∷ Functor CursorF
45+
derive instance eqCursor ∷ Eq a ⇒ Eq (CursorF a)
46+
derive instance ordCursor ∷ Ord a ⇒ Ord (CursorF a)
47+
48+
instance eq1CursorF ∷ Eq1 CursorF where
49+
eq1 = eq
50+
51+
instance ord1CursorF ∷ Ord1 CursorF where
52+
compare1 = compare
53+
54+
instance showCursorF ∷ Show a => Show (CursorF a) where
55+
show = case _ of
56+
All → "All"
57+
AtKey k a → "(AtKey " <> show k <> " " <> show a <> ")"
58+
AtIndex i a → "(AtIndex " <> show i <> " " <> show a <> ")"
59+
60+
-- | Peels off one layer of a cursor, if possible. The resulting tuple contains
61+
-- | the current step (made relative), and the remainder of the cursor.
62+
-- |
63+
-- | ``` purescript
64+
-- | peel (atKey (EJ.string "foo") $ atIndex 0 all) == Just (Tuple (atKey (EJ.string "foo") all) (atIndex 0 all))
65+
-- | peel (atIndex 0 all) == Just (Tuple (atIndex 0 all) all)
66+
-- | peel all == Nothing
67+
-- | ```
68+
peel ∷ Cursor → Maybe (Tuple Cursor Cursor)
69+
peel c = case unroll c of
70+
All → Nothing
71+
AtKey k rest → Just $ Tuple (atKey k all) rest
72+
AtIndex i rest → Just $ Tuple (atIndex i all) rest
73+
74+
-- | Takes a cursor and attempts to read from an EJson value, producing the
75+
-- | value the cursor points to, if it exists.
76+
get ∷ Cursor → EJson → Maybe EJson
77+
get = cata go
78+
where
79+
go :: Algebra CursorF (EJson -> Maybe EJson)
80+
go = case _ of
81+
All → Just
82+
AtKey k prior → getKey k <=< prior
83+
AtIndex i prior → getIndex i <=< prior
84+
85+
-- | Takes a cursor and attempts to set an EJson value within a larger EJson
86+
-- | value if the value the cursor points at exists.
87+
set ∷ Cursor → EJson → EJson → EJson
88+
set cur x v = case lmap unroll <$> peel cur of
89+
Nothing → x
90+
Just (Tuple All _) → x
91+
Just (Tuple (AtKey k _) path) → maybe v (setKey k x) $ get path v
92+
Just (Tuple (AtIndex i _) path) → maybe v (setIndex i x) $ get path v
93+
94+
-- | Attempts to lookup a key in an EJson Map, returning the associated value
95+
-- | if the key exists and the value is a Map.
96+
-- |
97+
-- | ``` purescript
98+
-- | getKey (EJ.string "foo") (EJ.map' $ EJ.string <$> SM.fromFoldable [Tuple "foo" "bar"]) == Just (EJ.string "bar")
99+
-- | getKey (EJ.string "foo") (EJ.map' $ EJ.string <$> SM.fromFoldable [Tuple "key" "value"]) == Nothing
100+
-- | getKey (EJ.string "foo") (EJ.boolean false) == Nothing
101+
-- | ```
102+
getKey ∷ EJ.EJson → EJ.EJson → Maybe EJ.EJson
103+
getKey k v = case EJ.head v of
104+
EJ.Map fields → EJ.EJson <$> lookup (EJ.getEJson k) fields
105+
_ → Nothing
106+
107+
-- | For a given key, attempts to set a new value for it in an EJson Map. If the
108+
-- | value is not a Map, or the key does not already exist, the original value
109+
-- | is returned.
110+
-- |
111+
-- | ``` purescript
112+
-- | let map = EJ.map' $ EJ.string <$> SM.fromFoldable [Tuple "foo" "bar"]
113+
-- | setKey (EJ.string "foo") (EJ.boolean true) map == EJ.map' (SM.fromFoldable [Tuple "foo" (EJ.boolean true)])
114+
-- | setKey (EJ.string "bar") (EJ.boolean true) map == map
115+
-- | setKey (EJ.string "foo") (EJ.boolean true) (EJ.string "not-a-map") == EJ.string "not-a-map"
116+
-- | ```
117+
setKey ∷ EJ.EJson → EJ.EJson → EJ.EJson → EJ.EJson
118+
setKey (EJ.EJson k) (EJ.EJson x) v = case EJ.head v of
119+
EJ.Map fields →
120+
EJ.EJson <<< roll <<< EJ.Map $ map
121+
(\(kv@(Tuple k' v)) → if k == k' then Tuple k x else kv) fields
122+
_ → v
123+
124+
-- | Attempts to lookup an index in an EJson Array, returning the associated
125+
-- | value if there is an item at that index, and the value is an Array.
126+
-- |
127+
-- | ``` purescript
128+
-- | getIndex 0 (EJ.array $ EJ.string <$> ["foo"]) == Just (EJ.string "foo")
129+
-- | getIndex 1 (EJ.array $ EJ.string <$> ["foo"]) == Nothing
130+
-- | getIndex 0 (EJ.boolean false) == Nothing
131+
-- | ```
132+
getIndex ∷ Int → EJ.EJson → Maybe EJ.EJson
133+
getIndex i v = case EJ.head v of
134+
EJ.Array items → EJ.EJson <$> A.index items i
135+
_ → Nothing
136+
137+
-- | For a given index, attempts to set a new value for it in an EJson Array. If
138+
-- | the value is not a Array, or the index does not already exist, the original
139+
-- | value is returned.
140+
-- |
141+
-- | ``` purescript
142+
-- | let array = EJ.array $ EJ.string <$> ["foo"]
143+
-- | setIndex 0 (EJ.boolean true) array == EJ.array [EJ.boolean true]
144+
-- | setIndex 1 (EJ.boolean true) array == array
145+
-- | setIndex 0 (EJ.boolean true) (EJ.string "not-an-array") == EJ.string "not-an-array"
146+
-- | ```
147+
setIndex ∷ Int → EJ.EJson → EJ.EJson → EJ.EJson
148+
setIndex i (EJ.EJson x) v = case EJ.head v of
149+
EJ.Array items →
150+
maybe v (EJ.EJson <<< roll <<< EJ.Array) $ A.updateAt i x items
151+
_ → v

‎test/Main.purs

+59
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,12 @@ import Control.Monad.Eff.Console (CONSOLE)
99
import Data.Argonaut.Decode (decodeJson)
1010
import Data.Argonaut.Encode (encodeJson)
1111
import Data.Either as E
12+
import Data.Maybe
13+
import Data.StrMap as SM
14+
import Data.Tuple
1215
import Data.Json.Extended (EJson, arbitraryJsonEncodableEJsonOfSize, arbitraryEJsonOfSize, renderEJson, parseEJson)
16+
import Data.Json.Extended as EJ
17+
import Data.Json.Extended.Cursor as EJC
1318

1419
import Text.Parsing.Parser as P
1520

@@ -45,7 +50,61 @@ testRenderParse =
4550
E.Right y → x == y SC.<?> "Mismatch:\n" <> show x <> "\n" <> show y
4651
E.Left err → SC.Failed $ "Parse error: " <> show err <> " when parsing:\n\n " <> renderEJson x <> "\n\n"
4752

53+
testCursorExamples ∷ Eff TestEffects Unit
54+
testCursorExamples = do
55+
assertEq
56+
(EJC.peel (EJC.atKey (EJ.string "foo") $ EJC.atIndex 0 EJC.all))
57+
(Just (Tuple (EJC.atKey (EJ.string "foo") EJC.all) (EJC.atIndex 0 EJC.all)))
58+
assertEq
59+
(EJC.peel (EJC.atIndex 0 EJC.all))
60+
(Just (Tuple (EJC.atIndex 0 EJC.all) EJC.all))
61+
assertEq
62+
(EJC.peel EJC.all)
63+
Nothing
64+
assertEq
65+
(EJC.getKey (EJ.string "foo") (EJ.map' $ EJ.string <$> SM.fromFoldable [Tuple "foo" "bar"]))
66+
(Just (EJ.string "bar"))
67+
assertEq
68+
(EJC.getKey (EJ.string "foo") (EJ.map' $ EJ.string <$> SM.fromFoldable [Tuple "key" "value"]))
69+
Nothing
70+
assertEq
71+
(EJC.getKey (EJ.string "foo") (EJ.boolean false))
72+
Nothing
73+
assertEq
74+
(EJC.getIndex 0 (EJ.array $ EJ.string <$> ["foo"]))
75+
(Just (EJ.string "foo"))
76+
assertEq
77+
(EJC.getIndex 1 (EJ.array $ EJ.string <$> ["foo"]))
78+
Nothing
79+
assertEq
80+
(EJC.getIndex 0 (EJ.boolean false))
81+
Nothing
82+
let map = EJ.map' $ EJ.string <$> SM.fromFoldable [Tuple "foo" "bar"]
83+
assertEq
84+
(EJC.setKey (EJ.string "foo") (EJ.boolean true) map)
85+
(EJ.map' (SM.fromFoldable [Tuple "foo" (EJ.boolean true)]))
86+
assertEq
87+
(EJC.setKey (EJ.string "bar") (EJ.boolean true) map)
88+
map
89+
assertEq
90+
(EJC.setKey (EJ.string "foo") (EJ.boolean true) (EJ.string "not-a-map"))
91+
(EJ.string "not-a-map")
92+
let array = EJ.array $ EJ.string <$> ["foo"]
93+
assertEq
94+
(EJC.setIndex 0 (EJ.boolean true) array)
95+
(EJ.array [EJ.boolean true])
96+
assertEq
97+
(EJC.setIndex 1 (EJ.boolean true) array)
98+
array
99+
assertEq
100+
(EJC.setIndex 0 (EJ.boolean true) (EJ.string "not-an-array"))
101+
(EJ.string "not-an-array")
102+
where
103+
assertEq ∷ ∀ a. (Show a, Eq a) ⇒ a → a → Eff TestEffects Unit
104+
assertEq x y = SC.assert $ SC.assertEq x y
105+
48106
main :: Eff TestEffects Unit
49107
main = do
50108
testJsonSerialization
51109
testRenderParse
110+
testCursorExamples

0 commit comments

Comments
 (0)