git.iko.soy/typeable/schematic
on 0.3.2.0 help sign in
typeable/schematic/test/SchemaSpec.hs
76 lines 2.3 kB history raw
1{-# OPTIONS_GHC -fprint-potential-instances #-}
3module SchemaSpec (spec, main) where
5import Data.Aeson
6import Data.ByteString.Lazy
7import Data.Functor.Identity
8import Data.Proxy
9import Data.Schematic
10import Data.Vinyl
11import Test.Hspec
14type SchemaExample
15 = 'SchemaObject
16 '[ '("foo", 'SchemaArray '[ 'AEq 1] ('SchemaNumber '[ 'NGt 10]))
17 , '("bar", 'SchemaOptional ('SchemaText '[ 'TEnum '["foo", "bar"]]))]
19type TestMigration =
20 'Migration "test_revision"
21 '[ 'Diff '[ 'PKey "bar" ] ('Update ('SchemaText '[]))
22 , 'Diff '[ 'PKey "foo" ] ('Update ('SchemaNumber '[])) ]
24type VS = 'Versioned SchemaExample '[ TestMigration ]
26jsonExample :: JsonRepr SchemaExample
27jsonExample = ReprObject $
28 FieldRepr (ReprArray [ReprNumber 12])
29 :& FieldRepr (ReprOptional (Just (ReprText "bar")))
30 :& RNil
32schemaJson :: ByteString
33schemaJson = "{\"foo\": [13], \"bar\": null}"
35schemaJson2 :: ByteString
36schemaJson2 = "{\"foo\": [3], \"bar\": null}"
38topObject
39 :: JsonRepr
40 ('SchemaObject
41 '[ '("foo", 'SchemaNumber '[])
42 , '("bar", 'SchemaText '[])])
43topObject = ReprObject $
44 FieldRepr (ReprNumber 42)
45 :& FieldRepr (ReprText "test")
46 :& RNil
48spec :: Spec
49spec = do
50 -- it "show/read JsonRepr properly" $
51 -- read (show example) == example
52 it "decode/encode JsonRepr properly" $
53 decode (encode jsonExample) == Just jsonExample
54 it "validates correct representation" $
55 ((decodeAndValidateJson schemaJson) :: ParseResult (JsonRepr SchemaExample))
56 `shouldSatisfy` isValid
57 it "returns decoding error on structurally incorrect input" $
58 ((decodeAndValidateJson "{}") :: ParseResult (JsonRepr SchemaExample))
59 `shouldSatisfy` isDecodingError
60 it "validates incorrect representation" $
61 ((decodeAndValidateJson schemaJson2) :: ParseResult (JsonRepr SchemaExample))
62 `shouldSatisfy` isValidationError
63 -- it "validates versioned json" $ do
64 -- decodeAndValidateVersionedJson (Proxy @VS) schemaJson
65 -- `shouldSatisfy` isValid
66 it "validates versioned json with a migration list" $ do
67 decodeAndValidateVersionedWithPureMList
68 (Proxy @VS)
69 ((:&&)
70 (Proxy @(SchemaByRevision "test_revision" VS))
71 (const $ Identity topObject) MNil)
72 schemaJson
73 `shouldSatisfy` isValid
75main :: IO ()
76main = hspec spec