git.iko.soy/schematic
on superrecord help sign in
schematic/test/SchemaSpec.hs
99 lines 3.0 kB history raw
1{-# OPTIONS_GHC -fprint-potential-instances #-}
3module SchemaSpec (spec, main) where
5import Control.Monad
6import Data.ByteString.Lazy
7import Data.Aeson
8import Data.Proxy
9import Data.Schematic
10import Data.Singletons
11import Data.Singletons.Prelude
12import Data.Vinyl
13import Test.Hspec
14import Test.Hspec.SmallCheck
15import Test.SmallCheck
16import Test.SmallCheck.Series.Instances
19type SchemaExample
20 = 'SchemaObject
21 '[ '("foo", 'SchemaArray '[AEq 1] ('SchemaNumber '[NGt 10]))
22 , '("bar", 'SchemaOptional ('SchemaText '[TEnum '["foo", "bar"]]))]
24type TestMigration =
25 'Migration "test_revision"
26 '[ 'Diff '[ 'PKey "bar" ] ('Update ('SchemaText '[]))
27 , 'Diff '[ 'PKey "foo" ] ('Update ('SchemaNumber '[])) ]
29type VS = 'Versioned SchemaExample '[ TestMigration ]
31exampleTest :: JsonRepr (SchemaOptional (SchemaText '[TEq 3]))
32exampleTest = ReprOptional (Just (ReprText "lil"))
34exampleNumber :: JsonRepr (SchemaNumber '[NGt 10])
35exampleNumber = ReprNumber 12
37exampleArray :: JsonRepr (SchemaArray '[AEq 1] (SchemaNumber '[NGt 10]))
38exampleArray = ReprArray [exampleNumber]
40jsonExample :: JsonRepr SchemaExample
41jsonExample = ReprObject $
42 FieldRepr (ReprArray [ReprNumber 12])
43 :& FieldRepr (ReprOptional (Just (ReprText "bar")))
44 :& RNil
46schemaJson :: ByteString
47schemaJson = "{\"foo\": [13], \"bar\": null}"
49schemaJson2 :: ByteString
50schemaJson2 = "{\"foo\": [3], \"bar\": null}"
52schemaJsonTopVersion :: ByteString
53schemaJsonTopVersion = "{ \"foo\": 42, \"bar\": \"bar\" }"
55topObject
56 :: JsonRepr
57 ('SchemaObject
58 '[ '("foo", 'SchemaNumber '[])
59 , '("bar", 'SchemaText '[])])
60topObject = ReprObject $
61 FieldRepr (ReprNumber 42)
62 :& FieldRepr (ReprText "test")
63 :& RNil
65instance
66 MigrateSchema
67 SchemaExample
68 ('SchemaObject
69 '[ '("foo", 'SchemaNumber '[]), '("bar", 'SchemaText '[])])
70 where
71 migrate = const topObject
73spec :: Spec
74spec = do
75 -- it "show/read JsonRepr properly" $
76 -- read (show example) == example
77 it "decode/encode JsonRepr properly" $
78 decode (encode jsonExample) == Just jsonExample
79 it "validates correct representation" $
80 ((decodeAndValidateJson schemaJson) :: ParseResult (JsonRepr SchemaExample))
81 `shouldSatisfy` isValid
82 it "returns decoding error on structurally incorrect input" $
83 ((decodeAndValidateJson "{}") :: ParseResult (JsonRepr SchemaExample))
84 `shouldSatisfy` isDecodingError
85 it "validates incorrect representation" $
86 ((decodeAndValidateJson schemaJson2) :: ParseResult (JsonRepr SchemaExample))
87 `shouldSatisfy` isValidationError
88 it "validates versioned json" $ do
89 decodeAndValidateVersionedJson (Proxy @VS) schemaJson
90 `shouldSatisfy` isValid
91 it "validates with Migration List" $ do
92 decodeAndValidateVersionedWithMList
93 (Proxy @VS)
94 ((:&&) (Proxy @(SchemaByRevision "test_revision" VS)) (const topObject) MNil)
95 schemaJson
96 `shouldSatisfy` isValid
98main :: IO ()
99main = hspec spec