/
Generic.purs
172 lines (144 loc) · 6.5 KB
/
Generic.purs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
module Data.Argonaut.Aeson.Encode.Generic
( class EncodeAeson
, class EncodeAeson'
, class EncodeRepArgs
, RepArgsEncoding(..)
, class EncodeRepFields
, encodeFields
, encodeAeson
, encodeAeson'
, encodeRepArgs
, genericEncodeAeson
) where
import Prelude (class Semigroup, otherwise, ($), (<<<), (<>), (==))
import Record (get)
import Data.Argonaut.Aeson.Options (Options(Options), SumEncoding(..))
import Data.Argonaut.Aeson.Helpers (class AreAllConstructorsNullary, class IsSingleConstructor, Mode(..), areAllConstructorsNullary, isSingleConstructor)
import Data.Argonaut.Core (Json, fromArray, fromObject, fromString, jsonEmptyArray)
import Data.Argonaut.Encode.Class (class EncodeJson, encodeJson)
import Data.Array (cons, uncons, head, length, snoc)
import Data.Generic.Rep as Rep
import Data.Maybe (Maybe(..), fromJust)
import Data.Symbol (class IsSymbol, reflectSymbol)
import Foreign.Object as FO
import Partial.Unsafe (unsafePartial)
import Type.Proxy (Proxy(..))
import Type.Row (class Cons)
import Type.RowList (Nil, Cons, RowList)
class EncodeAeson r where
encodeAeson :: Options -> r -> Json
instance encodeAesonInt :: EncodeAeson' Int => EncodeAeson Int where
encodeAeson = encodeAeson' mode
where
mode = Mode
{ _Mode_ConstructorIsSingle: false
, _Mode_ConstructorsAreAllNullary: false
}
instance encodeAesonNoConstructors :: EncodeAeson' Rep.NoConstructors => EncodeAeson Rep.NoConstructors where
encodeAeson = encodeAeson' mode
where
mode = Mode
{ _Mode_ConstructorIsSingle: false
, _Mode_ConstructorsAreAllNullary: false
}
instance encodeAesonConstructor
:: ( EncodeRepArgs a
, IsSymbol name
, AreAllConstructorsNullary (Rep.Constructor name a)
, IsSingleConstructor (Rep.Constructor name a)
)
=> EncodeAeson (Rep.Constructor name a) where
encodeAeson o thing = encodeAeson' mode o thing
where
mode = Mode
{ _Mode_ConstructorIsSingle: isSingleConstructor (Proxy :: Proxy (Rep.Constructor name a))
, _Mode_ConstructorsAreAllNullary: areAllConstructorsNullary (Proxy :: Proxy (Rep.Constructor name a))
}
instance encodeAesonSum
:: ( EncodeAeson' (Rep.Sum a b)
, AreAllConstructorsNullary (Rep.Sum a b)
, IsSingleConstructor (Rep.Sum a b)
)
=> EncodeAeson (Rep.Sum a b) where
encodeAeson o thing = encodeAeson' mode o thing
where
mode = Mode
{ _Mode_ConstructorIsSingle: isSingleConstructor (Proxy :: Proxy (Rep.Sum a b))
, _Mode_ConstructorsAreAllNullary: areAllConstructorsNullary (Proxy :: Proxy (Rep.Sum a b))
}
class EncodeAeson' r where
encodeAeson' :: Mode -> Options -> r -> Json
instance encodeAesonInt' :: EncodeAeson' Int where
encodeAeson' _ _ = encodeJson
instance encodeAesonNoConstructors' :: EncodeAeson' Rep.NoConstructors where
encodeAeson' x = encodeAeson' x
instance encodeAesonSum' :: (EncodeAeson' a, EncodeAeson' b) => EncodeAeson' (Rep.Sum a b) where
encodeAeson' o mode (Rep.Inl a) = encodeAeson' o mode a
encodeAeson' o mode (Rep.Inr b) = encodeAeson' o mode b
data RepArgsEncoding
= Arg (Array Json)
| Rec (FO.Object Json)
instance semigroupRepArgsEncoding :: Semigroup RepArgsEncoding where
append (Arg a) (Arg b) = Arg (a <> b)
append (Arg a) (Rec b) = Arg (snoc a $ fromObject b)
append (Rec a) (Arg b) = Arg (cons (fromObject a) b)
append (Rec a) (Rec b) = Arg [fromObject a, fromObject b]
instance encodeAesonConstructor' :: (IsSymbol name, EncodeRepArgs a) => EncodeAeson' (Rep.Constructor name a) where
encodeAeson' mode options (Rep.Constructor arguments) =
let name = reflectSymbol (Proxy :: Proxy name)
in case {mode: mode, options: options} of
{ mode: Mode {_Mode_ConstructorIsSingle: true, _Mode_ConstructorsAreAllNullary: true}
, options: Options {tagSingleConstructors: false, allNullaryToStringTag: true}
} -> jsonEmptyArray
{ mode: Mode {_Mode_ConstructorsAreAllNullary: true}
, options: Options {allNullaryToStringTag: true}
} -> encodeJson name
{ mode: Mode {_Mode_ConstructorIsSingle: true}
, options: Options {tagSingleConstructors: false}
} -> case encodeRepArgs arguments of
Rec foreignObject -> fromObject foreignObject
Arg xs -> case uncons xs of
Nothing -> jsonEmptyArray
Just {head: x, tail: ys} -> case uncons ys of
Nothing -> x
Just {head: y, tail: zs} -> fromArray ([x, y] <> zs)
{options: Options {sumEncoding: TaggedObject taggedObject}} ->
let o :: FO.Object Json
o = FO.insert taggedObject.tagFieldName (fromString (reflectSymbol (Proxy :: Proxy name))) FO.empty
in fromObject case encodeRepArgs arguments of
Rec o' -> o `FO.union` o'
Arg js
| length js == 0
-> o
| length js == 1
-> FO.insert taggedObject.contentsFieldName (unsafePartial fromJust $ head js) o
| otherwise
-> FO.insert taggedObject.contentsFieldName (fromArray js) o
class EncodeRepArgs r where
encodeRepArgs :: r -> RepArgsEncoding
instance encodeRepArgsNoArguments :: EncodeRepArgs Rep.NoArguments where
encodeRepArgs Rep.NoArguments = Arg []
instance encodeRepArgsProduct :: (EncodeRepArgs a, EncodeRepArgs b) => EncodeRepArgs (Rep.Product a b) where
encodeRepArgs (Rep.Product a b) = encodeRepArgs a <> encodeRepArgs b
instance encodeRepAesonArgsArgument :: EncodeJson a => EncodeRepArgs (Rep.Argument a) where
encodeRepArgs (Rep.Argument a) = Arg [encodeJson a]
-- | Encode record fields
class EncodeRepFields (rs :: RowList Type) (row :: Row Type) | rs -> row where
encodeFields :: Proxy rs -> Record row -> (FO.Object Json)
instance encodeRepFieldsCons ∷ ( IsSymbol name
, EncodeJson ty
, Cons name ty tailRow row
, EncodeRepFields tail row) ⇒ EncodeRepFields (Cons name ty tail) row where
encodeFields _ r =
let
name = reflectSymbol (Proxy ∷ Proxy name)
value = get (Proxy ∷ Proxy name) r
rest ∷ FO.Object Json
rest = encodeFields (Proxy ∷ Proxy tail) r
in
FO.insert name (encodeJson value) rest
instance encodeRepFieldsNil ∷ EncodeRepFields Nil row where
encodeFields _ _ = FO.empty
-- | Encode any `Generic` data structure into `Json` using `Aeson` encoding
genericEncodeAeson :: forall a r. Rep.Generic a r => EncodeAeson r => Options -> a -> Json
genericEncodeAeson o = encodeAeson o <<< Rep.from