1
1
module Data.Json.Extended
2
2
( module Exports
3
-
4
- , EJson (..)
5
- , getEJson
6
- , roll
7
- , unroll
8
- , head
9
-
3
+ , EJson
10
4
, null
11
5
, boolean
12
6
, integer
@@ -23,6 +17,8 @@ module Data.Json.Extended
23
17
24
18
, renderEJson
25
19
, parseEJson
20
+ , decodeEJson
21
+ , encodeEJson
26
22
27
23
, arbitraryEJsonOfSize
28
24
, arbitraryJsonEncodableEJsonOfSize
@@ -50,110 +46,43 @@ import Data.Functor as F
50
46
51
47
import Control.Lazy as Lazy
52
48
53
- import Data.Argonaut.Decode (class DecodeJson , decodeJson )
54
- import Data.Argonaut.Encode (class EncodeJson , encodeJson )
49
+ import Data.Argonaut as JS
55
50
import Data.Array as A
56
51
import Data.Bitraversable (bitraverse )
57
- import Data.Eq ( eq1 )
52
+ import Data.Either as E
58
53
import Data.Functor.Mu as Mu
59
54
import Data.HugeNum as HN
60
55
import Data.Json.Extended.Signature as Sig
61
56
import Data.Json.Extended.Type (EJsonType )
62
57
import Data.Lens (Prism' , preview , prism' )
63
58
import Data.Map as Map
64
59
import Data.Maybe as M
65
- import Data.Newtype as N
66
- import Data.Ord (compare1 )
67
60
import Data.StrMap as SM
68
61
import Data.Traversable (for )
69
62
import Data.Tuple as T
70
63
71
- import Matryoshka (class Corecursive , class Recursive , embed , project )
64
+ import Matryoshka (embed , project , cata , anaM )
72
65
73
66
import Test.StrongCheck.Arbitrary as SC
74
67
import Test.StrongCheck.Gen as Gen
75
68
import Text.Parsing.Parser as P
76
69
77
70
import Data.Json.Extended.Signature hiding (getType ) as Exports
78
71
79
- newtype EJson = EJson (Mu .Mu Sig.EJsonF )
80
-
81
- derive instance newtypeEJson :: N.Newtype EJson _
82
-
83
- instance recursiveEJson ∷ Recursive EJson Sig.EJsonF where
84
- project = N .traverse EJson project
85
-
86
- instance corecursiveEJson ∷ Corecursive EJson Sig.EJsonF where
87
- embed = N .collect EJson embed
88
-
89
- getEJson
90
- ∷ EJson
91
- → Mu.Mu Sig.EJsonF
92
- getEJson (EJson x) =
93
- x
94
-
95
- roll
96
- ∷ Sig.EJsonF EJson
97
- → EJson
98
- roll =
99
- EJson
100
- <<< Mu .roll
101
- <<< F .map getEJson
102
-
103
- unroll
104
- ∷ EJson
105
- → Sig.EJsonF EJson
106
- unroll =
107
- getEJson
108
- >>> Mu .unroll
109
- >>> F .map EJson
110
-
111
- head ∷ EJson → Sig.EJsonF (Mu.Mu Sig.EJsonF )
112
- head = Mu .unroll <<< getEJson
113
-
114
- instance eqEJson ∷ Eq EJson where
115
- eq (EJson a) (EJson b) =
116
- eq1 (Mu .unroll a) (Mu .unroll b)
117
-
118
- instance ordEJson ∷ Ord EJson where
119
- compare (EJson a) (EJson b) =
120
- compare1 (Mu .unroll a) (Mu .unroll b)
121
-
122
- instance showEJson ∷ Show EJson where
123
- show = renderEJson
124
-
125
- instance decodeJsonEJson ∷ DecodeJson EJson where
126
- decodeJson json =
127
- roll <$>
128
- Sig .decodeJsonEJsonF
129
- decodeJson
130
- (Sig.String >>> roll)
131
- json
132
-
133
- -- | This is a _lossy_ encoding of EJSON to JSON; JSON only supports objects with strings
134
- -- as keys.
135
- instance encodeJsonEJson ∷ EncodeJson EJson where
136
- encodeJson (EJson x) =
137
- Sig .encodeJsonEJsonF
138
- encodeJson
139
- asKey
140
- (EJson <$> Mu .unroll x)
141
-
142
- where
143
- asKey
144
- ∷ EJson
145
- → M.Maybe String
146
- asKey (EJson y) =
147
- case Mu .unroll y of
148
- Sig.String k → pure k
149
- _ → M.Nothing
72
+ type EJson = Mu.Mu Sig.EJsonF
73
+
150
74
75
+ decodeEJson ∷ JS.Json → E.Either String EJson
76
+ decodeEJson = anaM Sig .decodeJsonEJsonF
77
+
78
+ encodeEJson ∷ EJson → JS.Json
79
+ encodeEJson = cata Sig .encodeJsonEJsonF
151
80
152
81
arbitraryEJsonOfSize
153
82
∷ Gen.Size
154
83
→ Gen.Gen EJson
155
84
arbitraryEJsonOfSize size =
156
- roll <$>
85
+ embed <$>
157
86
case size of
158
87
0 → Sig .arbitraryBaseEJsonF
159
88
n → Sig .arbitraryEJsonF $ arbitraryEJsonOfSize (n - 1 )
@@ -163,139 +92,133 @@ arbitraryJsonEncodableEJsonOfSize
163
92
∷ Gen.Size
164
93
→ Gen.Gen EJson
165
94
arbitraryJsonEncodableEJsonOfSize size =
166
- roll <$>
95
+ embed <$>
167
96
case size of
168
97
0 → Sig .arbitraryBaseEJsonF
169
98
n → Sig .arbitraryEJsonFWithKeyGen keyGen $ arbitraryJsonEncodableEJsonOfSize (n - 1 )
170
99
where
171
100
keyGen =
172
- roll <<< Sig.String <$>
101
+ embed <<< Sig.String <$>
173
102
SC .arbitrary
174
103
175
- renderEJson
176
- ∷ EJson
177
- → String
178
- renderEJson (EJson x) =
179
- Sig .renderEJsonF
180
- renderEJson
181
- (EJson <$> Mu .unroll x)
104
+ renderEJson ∷ EJson → String
105
+ renderEJson =
106
+ cata Sig .renderEJsonF
107
+
182
108
183
109
-- | A closed parser of SQL^2 constant expressions
184
- parseEJson
185
- ∷ forall m
186
- . (Monad m )
187
- ⇒ P.ParserT String m EJson
110
+ parseEJson ∷ ∀ m . (Monad m ) ⇒ P.ParserT String m EJson
188
111
parseEJson =
189
112
Lazy .fix \f →
190
- roll <$>
113
+ embed <$>
191
114
Sig .parseEJsonF f
192
115
193
116
194
117
null ∷ EJson
195
- null = roll Sig.Null
118
+ null = embed Sig.Null
196
119
197
120
boolean ∷ Boolean → EJson
198
- boolean = roll <<< Sig.Boolean
121
+ boolean = embed <<< Sig.Boolean
199
122
200
123
integer ∷ Int → EJson
201
- integer = roll <<< Sig.Integer
124
+ integer = embed <<< Sig.Integer
202
125
203
126
decimal ∷ HN.HugeNum → EJson
204
- decimal = roll <<< Sig.Decimal
127
+ decimal = embed <<< Sig.Decimal
205
128
206
129
string ∷ String → EJson
207
- string = roll <<< Sig.String
130
+ string = embed <<< Sig.String
208
131
209
132
timestamp ∷ String → EJson
210
- timestamp = roll <<< Sig.Timestamp
133
+ timestamp = embed <<< Sig.Timestamp
211
134
212
135
date ∷ String → EJson
213
- date = roll <<< Sig.Date
136
+ date = embed <<< Sig.Date
214
137
215
138
time ∷ String → EJson
216
- time = roll <<< Sig.Time
139
+ time = embed <<< Sig.Time
217
140
218
141
interval ∷ String → EJson
219
- interval = roll <<< Sig.Interval
142
+ interval = embed <<< Sig.Interval
220
143
221
144
objectId ∷ String → EJson
222
- objectId = roll <<< Sig.ObjectId
145
+ objectId = embed <<< Sig.ObjectId
223
146
224
147
array ∷ Array EJson → EJson
225
- array = roll <<< Sig.Array
148
+ array = embed <<< Sig.Array
226
149
227
150
map ∷ Map.Map EJson EJson → EJson
228
- map = roll <<< Sig.Map <<< A .fromFoldable <<< Map .toList
151
+ map = embed <<< Sig.Map <<< A .fromFoldable <<< Map .toList
229
152
230
153
map' ∷ SM.StrMap EJson → EJson
231
- map' = roll <<< Sig.Map <<< F .map go <<< A .fromFoldable <<< SM .toList
154
+ map' = embed <<< Sig.Map <<< F .map go <<< A .fromFoldable <<< SM .toList
232
155
where
233
156
go (T.Tuple a b) = T.Tuple (string a) b
234
157
235
158
getType ∷ EJson → EJsonType
236
- getType = Sig .getType <<< head
159
+ getType = Sig .getType <<< project
237
160
238
161
_Null ∷ Prism' EJson Unit
239
- _Null = prism' (const null) $ head >>> case _ of
162
+ _Null = prism' (const null) $ project >>> case _ of
240
163
Sig.Null → M.Just unit
241
164
_ → M.Nothing
242
165
243
166
_String ∷ Prism' EJson String
244
- _String = prism' string $ head >>> case _ of
167
+ _String = prism' string $ project >>> case _ of
245
168
Sig.String s → M.Just s
246
169
_ → M.Nothing
247
170
248
171
_Boolean ∷ Prism' EJson Boolean
249
- _Boolean = prism' boolean $ head >>> case _ of
172
+ _Boolean = prism' boolean $ project >>> case _ of
250
173
Sig.Boolean b → M.Just b
251
174
_ → M.Nothing
252
175
253
176
_Integer ∷ Prism' EJson Int
254
- _Integer = prism' integer $ head >>> case _ of
177
+ _Integer = prism' integer $ project >>> case _ of
255
178
Sig.Integer i → M.Just i
256
179
_ → M.Nothing
257
180
258
181
_Decimal ∷ Prism' EJson HN.HugeNum
259
- _Decimal = prism' decimal $ head >>> case _ of
182
+ _Decimal = prism' decimal $ project >>> case _ of
260
183
Sig.Decimal d → M.Just d
261
184
_ → M.Nothing
262
185
263
186
_Timestamp ∷ Prism' EJson String
264
- _Timestamp = prism' timestamp $ head >>> case _ of
187
+ _Timestamp = prism' timestamp $ project >>> case _ of
265
188
Sig.Timestamp t → M.Just t
266
189
_ → M.Nothing
267
190
268
191
_Date ∷ Prism' EJson String
269
- _Date = prism' date $ head >>> case _ of
192
+ _Date = prism' date $ project >>> case _ of
270
193
Sig.Date d → M.Just d
271
194
_ → M.Nothing
272
195
273
196
_Time ∷ Prism' EJson String
274
- _Time = prism' time $ head >>> case _ of
197
+ _Time = prism' time $ project >>> case _ of
275
198
Sig.Time t → M.Just t
276
199
_ → M.Nothing
277
200
278
201
_Interval ∷ Prism' EJson String
279
- _Interval = prism' interval $ head >>> case _ of
202
+ _Interval = prism' interval $ project >>> case _ of
280
203
Sig.Interval i → M.Just i
281
204
_ → M.Nothing
282
205
283
206
_ObjectId ∷ Prism' EJson String
284
- _ObjectId = prism' objectId $ head >>> case _ of
207
+ _ObjectId = prism' objectId $ project >>> case _ of
285
208
Sig.ObjectId id → M.Just id
286
209
_ → M.Nothing
287
210
288
211
_Array ∷ Prism' EJson (Array EJson )
289
- _Array = prism' array $ unroll >>> case _ of
212
+ _Array = prism' array $ project >>> case _ of
290
213
Sig.Array xs → M.Just xs
291
214
_ → M.Nothing
292
215
293
216
_Map ∷ Prism' EJson (Map.Map EJson EJson )
294
- _Map = prism' map $ unroll >>> case _ of
217
+ _Map = prism' map $ project >>> case _ of
295
218
Sig.Map kvs → M.Just $ Map .fromFoldable kvs
296
219
_ → M.Nothing
297
220
298
221
_Map' ∷ Prism' EJson (SM.StrMap EJson )
299
- _Map' = prism' map' $ unroll >>> case _ of
222
+ _Map' = prism' map' $ project >>> case _ of
300
223
Sig.Map kvs → SM .fromFoldable <$> for kvs (bitraverse (preview _String) pure)
301
224
_ → M.Nothing
0 commit comments