11module 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
5147import 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
5550import Data.Array as A
5651import Data.Bitraversable (bitraverse )
57- import Data.Eq ( eq1 )
52+ import Data.Either as E
5853import Data.Functor.Mu as Mu
5954import Data.HugeNum as HN
6055import Data.Json.Extended.Signature as Sig
6156import Data.Json.Extended.Type (EJsonType )
6257import Data.Lens (Prism' , preview , prism' )
6358import Data.Map as Map
6459import Data.Maybe as M
65- import Data.Newtype as N
66- import Data.Ord (compare1 )
6760import Data.StrMap as SM
6861import Data.Traversable (for )
6962import Data.Tuple as T
7063
71- import Matryoshka (class Corecursive , class Recursive , embed , project )
64+ import Matryoshka (embed , project , cata , anaM )
7265
7366import Test.StrongCheck.Arbitrary as SC
7467import Test.StrongCheck.Gen as Gen
7568import Text.Parsing.Parser as P
7669
7770import 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 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+
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
15281arbitraryEJsonOfSize
15382 ∷ Gen.Size
15483 → Gen.Gen EJson
15584arbitraryEJsonOfSize size =
156- roll <$>
85+ embed <$>
15786 case size of
15887 0 → Sig .arbitraryBaseEJsonF
15988 n → Sig .arbitraryEJsonF $ arbitraryEJsonOfSize (n - 1 )
@@ -163,139 +92,133 @@ arbitraryJsonEncodableEJsonOfSize
16392 ∷ Gen.Size
16493 → Gen.Gen EJson
16594arbitraryJsonEncodableEJsonOfSize size =
166- roll <$>
95+ embed <$>
16796 case size of
16897 0 → Sig .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
188111parseEJson =
189112 Lazy .fix \f →
190- roll <$>
113+ embed <$>
191114 Sig .parseEJsonF f
192115
193116
194117null ∷ EJson
195- null = roll Sig.Null
118+ null = embed Sig.Null
196119
197120boolean ∷ Boolean → EJson
198- boolean = roll <<< Sig.Boolean
121+ boolean = embed <<< Sig.Boolean
199122
200123integer ∷ Int → EJson
201- integer = roll <<< Sig.Integer
124+ integer = embed <<< Sig.Integer
202125
203126decimal ∷ HN.HugeNum → EJson
204- decimal = roll <<< Sig.Decimal
127+ decimal = embed <<< Sig.Decimal
205128
206129string ∷ String → EJson
207- string = roll <<< Sig.String
130+ string = embed <<< Sig.String
208131
209132timestamp ∷ String → EJson
210- timestamp = roll <<< Sig.Timestamp
133+ timestamp = embed <<< Sig.Timestamp
211134
212135date ∷ String → EJson
213- date = roll <<< Sig.Date
136+ date = embed <<< Sig.Date
214137
215138time ∷ String → EJson
216- time = roll <<< Sig.Time
139+ time = embed <<< Sig.Time
217140
218141interval ∷ String → EJson
219- interval = roll <<< Sig.Interval
142+ interval = embed <<< Sig.Interval
220143
221144objectId ∷ String → EJson
222- objectId = roll <<< Sig.ObjectId
145+ objectId = embed <<< Sig.ObjectId
223146
224147array ∷ Array EJson → EJson
225- array = roll <<< Sig.Array
148+ array = embed <<< Sig.Array
226149
227150map ∷ Map.Map EJson EJson → EJson
228- map = roll <<< Sig.Map <<< A .fromFoldable <<< Map .toList
151+ map = embed <<< Sig.Map <<< A .fromFoldable <<< Map .toList
229152
230153map' ∷ 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
235158getType ∷ 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.Null → M.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