-
Notifications
You must be signed in to change notification settings - Fork 46
/
Class.purs
109 lines (84 loc) · 3.4 KB
/
Class.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
module Data.Argonaut.Encode.Class where
import Prelude
import Data.Argonaut.Core (Json, fromArray, fromBoolean, fromNumber, fromObject, fromString, jsonNull)
import Data.Either (Either, either)
import Data.Int (toNumber)
import Data.List (List(..), (:), toUnfoldable)
import Data.Map as M
import Data.Maybe (Maybe(..))
import Data.String (CodePoint)
import Data.String.CodePoints as CP
import Data.String.CodeUnits as CU
import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
import Data.Tuple (Tuple(..))
import Foreign.Object as FO
import Prim.Row as Row
import Prim.RowList as RL
import Record as Record
import Type.Data.RowList (RLProxy(..))
class EncodeJson a where
encodeJson :: a -> Json
instance encodeJsonMaybe :: EncodeJson a => EncodeJson (Maybe a) where
encodeJson Nothing = jsonNull
encodeJson (Just a) = encodeJson a
instance encodeJsonTuple :: (EncodeJson a, EncodeJson b) => EncodeJson (Tuple a b) where
encodeJson (Tuple a b) = encodeJson [encodeJson a, encodeJson b]
instance encodeJsonEither :: (EncodeJson a, EncodeJson b) => EncodeJson (Either a b) where
encodeJson = either (obj "Left") (obj "Right")
where
obj :: forall c. EncodeJson c => String -> c -> Json
obj tag x =
fromObject $ FO.fromFoldable $
Tuple "tag" (fromString tag) : Tuple "value" (encodeJson x) : Nil
instance encodeJsonUnit :: EncodeJson Unit where
encodeJson = const jsonNull
instance encodeJsonJBoolean :: EncodeJson Boolean where
encodeJson = fromBoolean
instance encodeJsonJNumber :: EncodeJson Number where
encodeJson = fromNumber
instance encodeJsonInt :: EncodeJson Int where
encodeJson = fromNumber <<< toNumber
instance encodeJsonJString :: EncodeJson String where
encodeJson = fromString
instance encodeJsonJson :: EncodeJson Json where
encodeJson = identity
instance encodeJsonCodePoint :: EncodeJson CodePoint where
encodeJson = encodeJson <<< CP.singleton
instance encodeJsonChar :: EncodeJson Char where
encodeJson = encodeJson <<< CU.singleton
instance encodeJsonArray :: EncodeJson a => EncodeJson (Array a) where
encodeJson json = fromArray (encodeJson <$> json)
instance encodeJsonList :: EncodeJson a => EncodeJson (List a) where
encodeJson = fromArray <<< map encodeJson <<< toUnfoldable
instance encodeForeignObject :: EncodeJson a => EncodeJson (FO.Object a) where
encodeJson = fromObject <<< map encodeJson
instance encodeMap :: (Ord a, EncodeJson a, EncodeJson b) => EncodeJson (M.Map a b) where
encodeJson = encodeJson <<< (M.toUnfoldable :: M.Map a b -> List (Tuple a b))
instance encodeVoid :: EncodeJson Void where
encodeJson = absurd
instance encodeRecord
:: ( GEncodeJson row list
, RL.RowToList row list
)
=> EncodeJson (Record row) where
encodeJson rec = fromObject $ gEncodeJson rec (RLProxy :: RLProxy list)
class GEncodeJson (row :: # Type) (list :: RL.RowList) where
gEncodeJson :: Record row -> RLProxy list -> FO.Object Json
instance gEncodeJsonNil :: GEncodeJson row RL.Nil where
gEncodeJson _ _ = FO.empty
instance gEncodeJsonCons
:: ( EncodeJson value
, GEncodeJson row tail
, IsSymbol field
, Row.Cons field value tail' row
)
=> GEncodeJson row (RL.Cons field value tail) where
gEncodeJson row _ =
let
sProxy :: SProxy field
sProxy = SProxy
in
FO.insert
(reflectSymbol sProxy)
(encodeJson $ Record.get sProxy row)
(gEncodeJson row $ RLProxy :: RLProxy tail)