git.iko.soy/typeable/schematic
on timing-type-equalities help sign in
typeable/schematic/test/SchemaSpec.hs
98 lines 3.0 kB history raw
1{-# OPTIONS_GHC -fprint-potential-instances #-}
3{-# LANGUAGE DataKinds #-}
4{-# LANGUAGE FlexibleContexts #-}
5{-# LANGUAGE GADTs #-}
6{-# LANGUAGE OverloadedLists #-}
7{-# LANGUAGE OverloadedStrings #-}
8{-# LANGUAGE RankNTypes #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE TypeApplications #-}
12module SchemaSpec (spec, main) where
14import Control.Lens
15import Data.Aeson
16import Data.ByteString.Lazy
17import Data.Functor.Identity
18import Data.Proxy
19import Data.Schematic
20import Data.Tagged
21import Data.Vinyl
22import Test.Hspec
25type SchemaExample = 'SchemaObject
26 '[ '("foo", 'SchemaArray '[ 'AEq 1] ('SchemaNumber '[ 'NGt 10]))
27 , '("bar", 'SchemaOptional ('SchemaText '[ 'TEnum '["foo", "bar"]]))]
29jsonExample :: JsonRepr SchemaExample
30jsonExample = withRepr @SchemaExample
31 $ field @"bar" (Just "bar")
32 :& field @"foo" [12]
33 :& RNil
35type AddQuuz =
36 'Migration "add_field_quuz"
37 '[ 'Diff '[] ('AddKey "quuz" (SchemaNumber '[])) ]
39type DeleteQuuz =
40 'Migration "remove_field_quuz"
41 '[ 'Diff '[] ( 'DeleteKey "quuz") ]
43type SwapFields =
44 'Migration "swap_fields"
45 '[ 'Diff '[ 'PKey "bar" ] ('Update
46 ('SchemaArray '[ 'AEq 1] ('SchemaNumber '[ 'NGt 10])))
47 , 'Diff '[ 'PKey "foo" ] ('Update
48 ('SchemaOptional ('SchemaText '[ 'TEnum '["foo", "bar"]]))) ]
50type Migrations = '[ AddQuuz
51 , DeleteQuuz ]
52 -- , SwapFields ]
54type VersionedJson = 'Versioned SchemaExample Migrations
56migrationList :: MigrationList Identity VersionedJson
57migrationList
58 = (migrateObject (\r -> Identity $ field @"quuz" 42 :& r))
59 :&& shrinkObject
60 -- :&& (migrateObject (\r -> Identity
61 -- $ field @"foo" (r ^. flens (Proxy @"bar") . _Just . optionalRepr)
62 -- :& field @"bar" (r ^. flens (Proxy @"foo") . arrayRepr)
63 -- :& RNil))
64 :&& MNil
66schemaJson :: ByteString
67schemaJson = "{\"foo\": [13], \"bar\": null}"
69schemaJson2 :: ByteString
70schemaJson2 = "{\"foo\": [3], \"bar\": null}"
72spec :: Spec
73spec = do
74 -- it "show/read JsonRepr properly" $
75 -- read (show example) == example
76 it "decode/encode JsonRepr properly" $
77 decode (encode jsonExample) == Just jsonExample
78 it "validates correct representation" $
79 ((decodeAndValidateJson schemaJson) :: ParseResult (JsonRepr SchemaExample))
80 `shouldSatisfy` isValid
81 it "returns decoding error on structurally incorrect input" $
82 ((decodeAndValidateJson "{}") :: ParseResult (JsonRepr SchemaExample))
83 `shouldSatisfy` isDecodingError
84 it "validates incorrect representation" $
85 ((decodeAndValidateJson schemaJson2) :: ParseResult (JsonRepr SchemaExample))
86 `shouldSatisfy` isValidationError
87 -- it "validates versioned json" $ do
88 -- decodeAndValidateVersionedJson (Proxy @VS) schemaJson
89 -- `shouldSatisfy` isValid
90 it "validates versioned json with a migration list" $ do
91 decodeAndValidateVersionedWithPureMList
92 (Proxy @VersionedJson)
93 migrationList
94 schemaJson
95 `shouldSatisfy` isValid
97main :: IO ()
98main = hspec spec