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

Commit 5934762

Browse files
authored
more matryoshka (#13)
* more matryoshka * removed EJson newtype wrapper * warnings
1 parent 0cf4892 commit 5934762

File tree

8 files changed

+317
-406
lines changed

8 files changed

+317
-406
lines changed

bower.json

+2-4
Original file line numberDiff line numberDiff line change
@@ -15,16 +15,14 @@
1515
"package.json"
1616
],
1717
"dependencies": {
18-
"purescript-argonaut-codecs": "^2.0.0",
19-
"purescript-argonaut-core": "^2.0.1",
2018
"purescript-bifunctors": "^2.0.0",
21-
"purescript-fixed-points": "^3.0.0",
2219
"purescript-maps": "^2.0.0",
2320
"purescript-matryoshka": "^0.2.0",
2421
"purescript-newtype": "^1.2.0",
2522
"purescript-parsing": "^3.0.0",
2623
"purescript-precise": "^1.0.0",
2724
"purescript-profunctor-lenses": "^2.4.0",
28-
"purescript-strongcheck": "^2.0.0"
25+
"purescript-strongcheck": "^2.0.0",
26+
"purescript-argonaut": "^2.0.0"
2927
}
3028
}

package.json

+4-4
Original file line numberDiff line numberDiff line change
@@ -6,9 +6,9 @@
66
"test": "pulp test"
77
},
88
"devDependencies": {
9-
"pulp": "^9.0.1",
10-
"purescript": "^0.10.1",
11-
"purescript-psa": "^0.3.9",
12-
"rimraf": "^2.5.4"
9+
"pulp": "^10.0.1",
10+
"purescript": "^0.10.7",
11+
"purescript-psa": "^0.4.0",
12+
"rimraf": "^2.6.1"
1313
}
1414
}

src/Data/Json/Extended.purs

+49-126
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,6 @@
11
module Data.Json.Extended
22
( module Exports
3-
4-
, EJson(..)
5-
, getEJson
6-
, roll
7-
, unroll
8-
, head
9-
3+
, EJson
104
, null
115
, boolean
126
, integer
@@ -23,6 +17,8 @@ module Data.Json.Extended
2317

2418
, renderEJson
2519
, parseEJson
20+
, decodeEJson
21+
, encodeEJson
2622

2723
, arbitraryEJsonOfSize
2824
, arbitraryJsonEncodableEJsonOfSize
@@ -50,110 +46,43 @@ import Data.Functor as F
5046

5147
import Control.Lazy as Lazy
5248

53-
import Data.Argonaut.Decode (class DecodeJson, decodeJson)
54-
import Data.Argonaut.Encode (class EncodeJson, encodeJson)
49+
import Data.Argonaut as JS
5550
import Data.Array as A
5651
import Data.Bitraversable (bitraverse)
57-
import Data.Eq (eq1)
52+
import Data.Either as E
5853
import Data.Functor.Mu as Mu
5954
import Data.HugeNum as HN
6055
import Data.Json.Extended.Signature as Sig
6156
import Data.Json.Extended.Type (EJsonType)
6257
import Data.Lens (Prism', preview, prism')
6358
import Data.Map as Map
6459
import Data.Maybe as M
65-
import Data.Newtype as N
66-
import Data.Ord (compare1)
6760
import Data.StrMap as SM
6861
import Data.Traversable (for)
6962
import Data.Tuple as T
7063

71-
import Matryoshka (class Corecursive, class Recursive, embed, project)
64+
import Matryoshka (embed, project, cata, anaM)
7265

7366
import Test.StrongCheck.Arbitrary as SC
7467
import Test.StrongCheck.Gen as Gen
7568
import Text.Parsing.Parser as P
7669

7770
import Data.Json.Extended.Signature hiding (getType) as Exports
7871

79-
newtype EJson = EJson (Mu.Mu Sig.EJsonF)
80-
81-
derive instance newtypeEJson :: N.Newtype EJson _
82-
83-
instance recursiveEJsonRecursive EJson Sig.EJsonF where
84-
project = N.traverse EJson project
85-
86-
instance corecursiveEJsonCorecursive 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 eqEJsonEq EJson where
115-
eq (EJson a) (EJson b) =
116-
eq1 (Mu.unroll a) (Mu.unroll b)
117-
118-
instance ordEJsonOrd EJson where
119-
compare (EJson a) (EJson b) =
120-
compare1 (Mu.unroll a) (Mu.unroll b)
121-
122-
instance showEJsonShow EJson where
123-
show = renderEJson
124-
125-
instance decodeJsonEJsonDecodeJson 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 encodeJsonEJsonEncodeJson 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+
15074

75+
decodeEJson JS.Json E.Either String EJson
76+
decodeEJson = anaM Sig.decodeJsonEJsonF
77+
78+
encodeEJson EJson JS.Json
79+
encodeEJson = cata Sig.encodeJsonEJsonF
15180

15281
arbitraryEJsonOfSize
15382
Gen.Size
15483
Gen.Gen EJson
15584
arbitraryEJsonOfSize size =
156-
roll <$>
85+
embed <$>
15786
case size of
15887
0Sig.arbitraryBaseEJsonF
15988
n → Sig.arbitraryEJsonF $ arbitraryEJsonOfSize (n - 1)
@@ -163,139 +92,133 @@ arbitraryJsonEncodableEJsonOfSize
16392
Gen.Size
16493
Gen.Gen EJson
16594
arbitraryJsonEncodableEJsonOfSize size =
166-
roll <$>
95+
embed <$>
16796
case size of
16897
0Sig.arbitraryBaseEJsonF
16998
n → Sig.arbitraryEJsonFWithKeyGen keyGen $ arbitraryJsonEncodableEJsonOfSize (n - 1)
17099
where
171100
keyGen =
172-
roll <<< Sig.String <$>
101+
embed <<< Sig.String <$>
173102
SC.arbitrary
174103

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+
182108

183109
-- | 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
188111
parseEJson =
189112
Lazy.fix \f →
190-
roll <$>
113+
embed <$>
191114
Sig.parseEJsonF f
192115

193116

194117
null EJson
195-
null = roll Sig.Null
118+
null = embed Sig.Null
196119

197120
boolean Boolean EJson
198-
boolean = roll <<< Sig.Boolean
121+
boolean = embed <<< Sig.Boolean
199122

200123
integer Int EJson
201-
integer = roll <<< Sig.Integer
124+
integer = embed <<< Sig.Integer
202125

203126
decimal HN.HugeNum EJson
204-
decimal = roll <<< Sig.Decimal
127+
decimal = embed <<< Sig.Decimal
205128

206129
string String EJson
207-
string = roll <<< Sig.String
130+
string = embed <<< Sig.String
208131

209132
timestamp String EJson
210-
timestamp = roll <<< Sig.Timestamp
133+
timestamp = embed <<< Sig.Timestamp
211134

212135
date String EJson
213-
date = roll <<< Sig.Date
136+
date = embed <<< Sig.Date
214137

215138
time String EJson
216-
time = roll <<< Sig.Time
139+
time = embed <<< Sig.Time
217140

218141
interval String EJson
219-
interval = roll <<< Sig.Interval
142+
interval = embed <<< Sig.Interval
220143

221144
objectId String EJson
222-
objectId = roll <<< Sig.ObjectId
145+
objectId = embed <<< Sig.ObjectId
223146

224147
array Array EJson EJson
225-
array = roll <<< Sig.Array
148+
array = embed <<< Sig.Array
226149

227150
map Map.Map EJson EJson EJson
228-
map = roll <<< Sig.Map <<< A.fromFoldable <<< Map.toList
151+
map = embed <<< Sig.Map <<< A.fromFoldable <<< Map.toList
229152

230153
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
232155
where
233156
go (T.Tuple a b) = T.Tuple (string a) b
234157

235158
getType EJson EJsonType
236-
getType = Sig.getType <<< head
159+
getType = Sig.getType <<< project
237160

238161
_Null Prism' EJson Unit
239-
_Null = prism' (const null) $ head >>> case _ of
162+
_Null = prism' (const null) $ project >>> case _ of
240163
Sig.NullM.Just unit
241164
_ → M.Nothing
242165

243166
_String Prism' EJson String
244-
_String = prism' string $ head >>> case _ of
167+
_String = prism' string $ project >>> case _ of
245168
Sig.String s → M.Just s
246169
_ → M.Nothing
247170

248171
_Boolean Prism' EJson Boolean
249-
_Boolean = prism' boolean $ head >>> case _ of
172+
_Boolean = prism' boolean $ project >>> case _ of
250173
Sig.Boolean b → M.Just b
251174
_ → M.Nothing
252175

253176
_Integer Prism' EJson Int
254-
_Integer = prism' integer $ head >>> case _ of
177+
_Integer = prism' integer $ project >>> case _ of
255178
Sig.Integer i → M.Just i
256179
_ → M.Nothing
257180

258181
_Decimal Prism' EJson HN.HugeNum
259-
_Decimal = prism' decimal $ head >>> case _ of
182+
_Decimal = prism' decimal $ project >>> case _ of
260183
Sig.Decimal d → M.Just d
261184
_ → M.Nothing
262185

263186
_Timestamp Prism' EJson String
264-
_Timestamp = prism' timestamp $ head >>> case _ of
187+
_Timestamp = prism' timestamp $ project >>> case _ of
265188
Sig.Timestamp t → M.Just t
266189
_ → M.Nothing
267190

268191
_Date Prism' EJson String
269-
_Date = prism' date $ head >>> case _ of
192+
_Date = prism' date $ project >>> case _ of
270193
Sig.Date d → M.Just d
271194
_ → M.Nothing
272195

273196
_Time Prism' EJson String
274-
_Time = prism' time $ head >>> case _ of
197+
_Time = prism' time $ project >>> case _ of
275198
Sig.Time t → M.Just t
276199
_ → M.Nothing
277200

278201
_Interval Prism' EJson String
279-
_Interval = prism' interval $ head >>> case _ of
202+
_Interval = prism' interval $ project >>> case _ of
280203
Sig.Interval i → M.Just i
281204
_ → M.Nothing
282205

283206
_ObjectId Prism' EJson String
284-
_ObjectId = prism' objectId $ head >>> case _ of
207+
_ObjectId = prism' objectId $ project >>> case _ of
285208
Sig.ObjectId id → M.Just id
286209
_ → M.Nothing
287210

288211
_Array Prism' EJson (Array EJson)
289-
_Array = prism' array $ unroll >>> case _ of
212+
_Array = prism' array $ project >>> case _ of
290213
Sig.Array xs → M.Just xs
291214
_ → M.Nothing
292215

293216
_Map Prism' EJson (Map.Map EJson EJson)
294-
_Map = prism' map $ unroll >>> case _ of
217+
_Map = prism' map $ project >>> case _ of
295218
Sig.Map kvs → M.Just $ Map.fromFoldable kvs
296219
_ → M.Nothing
297220

298221
_Map' Prism' EJson (SM.StrMap EJson)
299-
_Map' = prism' map' $ unroll >>> case _ of
222+
_Map' = prism' map' $ project >>> case _ of
300223
Sig.Map kvs → SM.fromFoldable <$> for kvs (bitraverse (preview _String) pure)
301224
_ → M.Nothing

0 commit comments

Comments
 (0)