forked from paf31/purescript-foreign-generic
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathMain.purs
126 lines (114 loc) · 3.86 KB
/
Main.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
module Test.Main where
import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Control.Monad.Except (runExcept)
import Data.Bifunctor (bimap)
import Data.Either (Either(..))
import Data.Foreign.Class (class Encode, class Decode)
import Data.Foreign.Generic (decodeJSON, defaultOptions, encodeJSON, genericDecodeJSON, genericEncodeJSON)
import Data.Foreign.Generic.Class (class GenericDecode, class GenericEncode, encodeFields)
import Data.Foreign.Generic.EnumEncoding (class GenericDecodeEnum, class GenericEncodeEnum, GenericEnumOptions, genericDecodeEnum, genericEncodeEnum)
import Data.Foreign.Generic.Types (Options, SumEncoding(..))
import Data.Foreign.JSON (parseJSON)
import Data.Foreign.NullOrUndefined (NullOrUndefined(..))
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Data.StrMap as StrMap
import Data.String (toLower, toUpper)
import Data.Tuple (Tuple(..))
import Global.Unsafe (unsafeStringify)
import Test.Assert (assert, assert', ASSERT)
import Test.Types (Fruit(..), IntList(..), RecordTest(..), Tree(..), TupleArray(..), UndefinedTest(..))
buildTree :: forall a. (a -> TupleArray a a) -> Int -> a -> Tree a
buildTree _ 0 a = Leaf a
buildTree f n a = Branch $ buildTree (bimap f f) (n - 1) (f a)
-- A balanced binary tree of depth N
makeTree :: Int -> Tree Int
makeTree n = buildTree (\i -> TupleArray (Tuple (2 * i) (2 * i + 1))) n 0
throw :: forall eff. String -> Eff (assert :: ASSERT | eff) Unit
throw = flip assert' false
testRoundTrip
:: ∀ a eff
. Eq a
=> Decode a
=> Encode a
=> a
-> Eff ( console :: CONSOLE
, assert :: ASSERT
| eff
) Unit
testRoundTrip x = do
let json = encodeJSON x
log json
case runExcept (decodeJSON json) of
Right y -> assert (x == y)
Left err -> throw (show err)
testGenericRoundTrip
:: ∀ a r eff
. Eq a
=> Generic a r
=> GenericDecode r
=> GenericEncode r
=> Options
-> a
-> Eff ( console :: CONSOLE
, assert :: ASSERT
| eff
) Unit
testGenericRoundTrip opts x = do
let json = genericEncodeJSON opts x
log json
case runExcept (genericDecodeJSON opts json) of
Right y -> assert (x == y)
Left err -> throw (show err)
testOption
:: ∀ a rep eff
. Eq a
=> Generic a rep
=> GenericEncodeEnum rep
=> GenericDecodeEnum rep
=> GenericEnumOptions
-> String
-> a
-> Eff ( console :: CONSOLE
, assert :: ASSERT
| eff
) Unit
testOption options string value = do
let json = unsafeStringify $ genericEncodeEnum options value
log json
case runExcept $ Tuple <$> decode' json <*> decode' string of
Right (Tuple x y) -> assert (value == y && value == x)
Left err -> throw (show err)
where
decode' = genericDecodeEnum options <=< parseJSON
testUnaryConstructorLiteral :: forall e.
Eff
( console :: CONSOLE
, assert :: ASSERT
| e
)
Unit
testUnaryConstructorLiteral = do
testOption (makeCasingOptions toUpper) "\"FRIKANDEL\"" Frikandel
testOption (makeCasingOptions toLower) "\"frikandel\"" Frikandel
where
makeCasingOptions f =
{ constructorTagTransform: f
}
main :: forall eff. Eff (console :: CONSOLE, assert :: ASSERT | eff) Unit
main = do
testRoundTrip (RecordTest { foo: 1, bar: "test", baz: 'a' })
testRoundTrip (Cons 1 (Cons 2 (Cons 3 Nil)))
testRoundTrip (UndefinedTest {a: NullOrUndefined (Just "test")})
testRoundTrip (UndefinedTest {a: NullOrUndefined Nothing})
testRoundTrip [NullOrUndefined (Just "test")]
testRoundTrip [NullOrUndefined (Nothing :: Maybe String)]
testRoundTrip (Apple)
testRoundTrip (makeTree 0)
testRoundTrip (makeTree 5)
testRoundTrip (StrMap.fromFoldable [Tuple "one" 1, Tuple "two" 2])
testUnaryConstructorLiteral
let opts = defaultOptions { fieldTransform = toUpper }
testGenericRoundTrip opts (RecordTest { foo: 1, bar: "test", baz: 'a' })