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
module Gargantext.Utils.Argonaut where
import Prelude
import Control.Alt ((<|>))
import Data.Argonaut (Json)
import Data.Argonaut as Argonaut
import Data.Argonaut.Decode.Error (JsonDecodeError(..))
import Data.Either (Either(..))
import Data.Generic.Rep as GR
import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
-- | Provide a generic sum JSON decoding for sum types deriving Generic
genericSumDecodeJson
:: forall a rep
. GR.Generic a rep
=> GenericSumDecodeJsonRep rep
=> Json
-> Either JsonDecodeError a
genericSumDecodeJson f =
GR.to <$> genericSumDecodeJsonRep f
-- | Provide a generic sum JSON encoding for sum types deriving Generic
genericSumEncodeJson
:: forall a rep
. GR.Generic a rep
=> GenericSumEncodeJsonRep rep
=> a
-> Json
genericSumEncodeJson f =
genericSumEncodeJsonRep $ GR.from f
class GenericSumDecodeJsonRep rep where
genericSumDecodeJsonRep :: Json -> Either JsonDecodeError rep
class GenericSumEncodeJsonRep rep where
genericSumEncodeJsonRep :: rep -> Json
instance
( GenericSumDecodeJsonRep a
, GenericSumDecodeJsonRep b
) => GenericSumDecodeJsonRep (GR.Sum a b) where
genericSumDecodeJsonRep f
= GR.Inl <$> genericSumDecodeJsonRep f
<|> GR.Inr <$> genericSumDecodeJsonRep f
instance
( GenericSumDecodeJsonRep a
, IsSymbol name
) => GenericSumDecodeJsonRep (GR.Constructor name a) where
genericSumDecodeJsonRep f = do
-- here we attempt to read the following json:
-- { "ConstructorName": argument }
let name = reflectSymbol (SProxy :: _ name)
obj <- Argonaut.decodeJson f
inner <- Argonaut.getField obj name
argument <- genericSumDecodeJsonRep inner
pure $ GR.Constructor argument
instance
GenericSumDecodeJsonRep (GR.NoArguments) where
genericSumDecodeJsonRep _ = do
pure GR.NoArguments
instance
( Argonaut.DecodeJson a
) => GenericSumDecodeJsonRep (GR.Argument a) where
genericSumDecodeJsonRep f = GR.Argument <$> Argonaut.decodeJson f
instance
( GenericSumEncodeJsonRep a
, GenericSumEncodeJsonRep b
) => GenericSumEncodeJsonRep (GR.Sum a b) where
genericSumEncodeJsonRep (GR.Inl f) = genericSumEncodeJsonRep f
genericSumEncodeJsonRep (GR.Inr f) = genericSumEncodeJsonRep f
instance
( GenericSumEncodeJsonRep a
, IsSymbol name
) => GenericSumEncodeJsonRep (GR.Constructor name a) where
genericSumEncodeJsonRep (GR.Constructor inner) = do
-- here we attempt to write the following json:
-- { "ConstructorName": argument }
let name = reflectSymbol (SProxy :: _ name)
let argument = genericSumEncodeJsonRep inner
Argonaut.jsonSingletonObject name argument
instance
GenericSumEncodeJsonRep GR.NoArguments where
genericSumEncodeJsonRep GR.NoArguments = Argonaut.jsonNull
instance
( Argonaut.EncodeJson a
) => GenericSumEncodeJsonRep (GR.Argument a) where
genericSumEncodeJsonRep (GR.Argument f) = Argonaut.encodeJson f
genericEnumDecodeJson :: forall a rep
. GR.Generic a rep
=> GenericEnumDecodeJson rep
=> Json
-> Either JsonDecodeError a
genericEnumDecodeJson f =
GR.to <$> genericEnumDecodeJsonRep f
-- | Generic Enum Sum Representations, with constructor names as strings
class GenericEnumDecodeJson rep where
genericEnumDecodeJsonRep :: Json -> Either JsonDecodeError rep
instance
( GenericEnumDecodeJson a
, GenericEnumDecodeJson b
) => GenericEnumDecodeJson (GR.Sum a b) where
genericEnumDecodeJsonRep f
= GR.Inl <$> genericEnumDecodeJsonRep f
<|> GR.Inr <$> genericEnumDecodeJsonRep f
instance
( IsSymbol name
) => GenericEnumDecodeJson (GR.Constructor name GR.NoArguments) where
genericEnumDecodeJsonRep f = do
s <- Argonaut.decodeJson f
if s == name
then pure $ GR.Constructor GR.NoArguments
else Left $ Named s $ TypeMismatch $ "Enum did not match expected string " <> name
where
name = reflectSymbol (SProxy :: SProxy name)
genericEnumEncodeJson :: forall a rep
. GR.Generic a rep
=> GenericEnumEncodeJson rep
=> a
-> Json
genericEnumEncodeJson f =
genericEnumEncodeJsonRep $ GR.from f
-- | Generic Enum Sum Representations, with constructor names as strings
class GenericEnumEncodeJson rep where
genericEnumEncodeJsonRep :: rep -> Json
instance
( GenericEnumEncodeJson a
, GenericEnumEncodeJson b
) => GenericEnumEncodeJson (GR.Sum a b) where
genericEnumEncodeJsonRep (GR.Inl x) = genericEnumEncodeJsonRep x
genericEnumEncodeJsonRep (GR.Inr x) = genericEnumEncodeJsonRep x
instance
( IsSymbol name
) => GenericEnumEncodeJson (GR.Constructor name GR.NoArguments) where
genericEnumEncodeJsonRep _ = Argonaut.encodeJson $ reflectSymbol (SProxy :: SProxy name)