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
|
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Database.Persist.TH.JsonEncodingSpec where
import TemplateTestImports
import Data.Aeson
import Data.Text (Text)
import Test.Hspec.QuickCheck
import Test.QuickCheck
import Test.QuickCheck.Instances ()
import Database.Persist.EntityDef
import Database.Persist.ImplicitIdDef
import Database.Persist.ImplicitIdDef.Internal (fieldTypeFromTypeable)
import Database.Persist.Types
mkPersist sqlSettings [persistLowerCase|
JsonEncoding json
name Text
age Int
Primary name
deriving Show Eq
JsonEncoding2 json
name Text
age Int
blood Text
Primary name blood
deriving Show Eq
JsonEncMigrationOnly json
name Text
age Int
foo Text MigrationOnly
|]
instance Arbitrary JsonEncoding where
arbitrary = JsonEncoding <$> arbitrary <*> arbitrary
instance Arbitrary JsonEncoding2 where
arbitrary = JsonEncoding2 <$> arbitrary <*> arbitrary <*> arbitrary
pass :: IO ()
pass = pure ()
asIO :: IO a -> IO a
asIO = id
spec :: Spec
spec = describe "JsonEncodingSpec" $ do
let
subject =
JsonEncoding "Bob" 32
subjectEntity =
Entity (JsonEncodingKey (jsonEncodingName subject)) subject
it "encodes without an ID field" $ do
toJSON subjectEntity
`shouldBe`
object
[ ("name", String "Bob")
, ("age", toJSON (32 :: Int))
, ("id", String "Bob")
]
it "decodes without an ID field" $ do
let
json_ = encode . object $
[ ("name", String "Bob")
, ("age", toJSON (32 :: Int))
]
eitherDecode json_
`shouldBe`
Right subjectEntity
it "has informative decoder errors" $ do
let
json_ = encode Null
(eitherDecode json_ :: Either String JsonEncoding)
`shouldBe`
Left "Error in $: parsing JsonEncoding failed, expected Object, but encountered Null"
prop "works with a Primary" $ \jsonEncoding -> do
let
ent =
Entity (JsonEncodingKey (jsonEncodingName jsonEncoding)) jsonEncoding
decode (encode ent)
`shouldBe`
Just ent
prop "excuse me what" $ \j@JsonEncoding{..} -> do
let
ent =
Entity (JsonEncodingKey jsonEncodingName) j
toJSON ent
`shouldBe`
object
[ ("name", toJSON jsonEncodingName)
, ("age", toJSON jsonEncodingAge)
, ("id", toJSON jsonEncodingName)
]
prop "round trip works with composite key" $ \j@JsonEncoding2{..} -> do
let
key = JsonEncoding2Key jsonEncoding2Name jsonEncoding2Blood
ent =
Entity key j
decode (encode ent)
`shouldBe`
Just ent
prop "works with a composite key" $ \j@JsonEncoding2{..} -> do
let
key = JsonEncoding2Key jsonEncoding2Name jsonEncoding2Blood
ent =
Entity key j
toJSON ent
`shouldBe`
object
[ ("name", toJSON jsonEncoding2Name)
, ("age", toJSON jsonEncoding2Age)
, ("blood", toJSON jsonEncoding2Blood)
, ("id", toJSON key)
]
|
