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 genericSumDecodeJsonRepSum ::
( GenericSumDecodeJsonRep a
, GenericSumDecodeJsonRep b
) => GenericSumDecodeJsonRep (GR.Sum a b) where
genericSumDecodeJsonRep f
= GR.Inl <$> genericSumDecodeJsonRep f
<|> GR.Inr <$> genericSumDecodeJsonRep f
instance genericSumDecodeJsonRepConstructor ::
( 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 genericSumDecodeJsonRepNoArguments ::
GenericSumDecodeJsonRep (GR.NoArguments) where
genericSumDecodeJsonRep _ = do
pure GR.NoArguments
instance genericSumDecodeJsonRepArgument ::
( Argonaut.DecodeJson a
) => GenericSumDecodeJsonRep (GR.Argument a) where
genericSumDecodeJsonRep f = GR.Argument <$> Argonaut.decodeJson f
instance genericSumEncodeJsonRepSum ::
( GenericSumEncodeJsonRep a
, GenericSumEncodeJsonRep b
) => GenericSumEncodeJsonRep (GR.Sum a b) where
genericSumEncodeJsonRep (GR.Inl f) = genericSumEncodeJsonRep f
genericSumEncodeJsonRep (GR.Inr f) = genericSumEncodeJsonRep f
instance genericSumEncodeJsonRepConstructor ::
( 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 genericSumEncodeJsonRepNoArguments ::
GenericSumEncodeJsonRep GR.NoArguments where
genericSumEncodeJsonRep GR.NoArguments = Argonaut.jsonNull
instance genericSumEncodeJsonRepArgument ::
( 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 sumEnumDecodeJsonRep ::
( GenericEnumDecodeJson a
, GenericEnumDecodeJson b
) => GenericEnumDecodeJson (GR.Sum a b) where
genericEnumDecodeJsonRep f
= GR.Inl <$> genericEnumDecodeJsonRep f
<|> GR.Inr <$> genericEnumDecodeJsonRep f
instance constructorEnumSumRep ::
( 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 sumGenericEnumEncodeJson ::
( GenericEnumEncodeJson a
, GenericEnumEncodeJson b
) => GenericEnumEncodeJson (GR.Sum a b) where
genericEnumEncodeJsonRep (GR.Inl x) = genericEnumEncodeJsonRep x
genericEnumEncodeJsonRep (GR.Inr x) = genericEnumEncodeJsonRep x
instance constructorGenericEnumEncodeJson ::
( IsSymbol name
) => GenericEnumEncodeJson (GR.Constructor name GR.NoArguments) where
genericEnumEncodeJsonRep _ = Argonaut.encodeJson $ reflectSymbol (SProxy :: SProxy name)