on master help sign in
small fixes
commit1190166a82d18032e43e6b9ddb6751e5d10b202d authorDenis Redozubov <denis.redozubov@gmail.com> dateWed 11 Oct 2017, 18:28 (9 years ago) parent5be2bf6
6 files changed+8−47
src/Data/Schematic/Schema.hs+1−14 src/Data/Schematic/Validation.hs+1−1 test/HelpersSpec.hs−6 test/JsonSchemaSpec.hs+4−12 test/LensSpec.hs−6 test/SchemaSpec.hs+2−8
src/Data/Schematic/Schema.hs+1−14
@@ -331,20 +331,9 @@ data JsonRepr :: Schema -> Type where
331331 ReprArray :: V.Vector (JsonRepr s) -> JsonRepr ('SchemaArray cs s)
332332 ReprObject :: Rec FieldRepr fs -> JsonRepr ('SchemaObject fs)
333333 ReprOptional :: Maybe (JsonRepr s) -> JsonRepr ('SchemaOptional s)
334− ReprUnion
335− -- :: USubsets (h ': tl)
336− :: Union JsonRepr (h ': tl)
337− -> JsonRepr ('SchemaUnion (h ': tl))
334+ ReprUnion :: Union JsonRepr (h ': tl) -> JsonRepr ('SchemaUnion (h ': tl))
338335
339336-- | Move to the union package
340−type family UnionAll (f :: u -> *) (rs :: [u]) (c :: * -> Constraint) :: Constraint where
341− UnionAll f '[] c = ()
342− UnionAll f (r ': rs) c = (c (f r), UnionAll f rs c)
343−
344−-- instance (UnionAll f as Show) => Show (Union f as) where
345−-- show (This fa) = "This " P.++ show fa
346−-- show (That u) = "That " P.++ show u
347−
348337instance Show (JsonRepr ('SchemaText cs)) where
349338 show (ReprText t) = "ReprText " P.++ show t
350339
@@ -362,8 +351,6 @@ instance V.RecAll FieldRepr fs Show => Show (JsonRepr ('SchemaObject fs)) where
362351instance Show (JsonRepr s) => Show (JsonRepr ('SchemaOptional s)) where
363352 show (ReprOptional s) = "ReprOptional " P.++ show s
364353
365−deriving instance UnionAll f as Show => Show (Union f as)
366−
367354instance (Monad m, Serial m Text)
368355 => Serial m (JsonRepr ('SchemaText cs)) where
369356 series = cons1 ReprText
src/Data/Schematic/Validation.hs+1−1
@@ -207,7 +207,7 @@ validateJsonRepr sschema dpath jr = case jr of
207207 let newPath = dpath <> [DKey (knownFieldName f)]
208208 validateJsonRepr (knownFieldSchema f) newPath d
209209 go ftl
210− ReprUnion u -> pure ()
210+ ReprUnion _ -> pure () -- FIXME
211211 -- case sschema of
212212 -- SSchemaUnion ss -> case ss of
213213 -- SCons s stl -> case umatch' s u of
test/HelpersSpec.hs−6
@@ -3,18 +3,12 @@
33module HelpersSpec (spec, main) where
44
55import Control.Lens
6−import Data.Aeson
7−import Data.ByteString.Char8 as C8
8−import Data.ByteString.Lazy as BL
96import Data.ByteString.Lazy.Lens
107import Data.Foldable
11−import Data.Functor.Identity
128import Data.Monoid
13−import Data.Proxy
149import Data.Schematic
1510import Data.Text as T
1611import Data.Text.Lens
17−import Data.Vinyl
1812import Test.Hspec
1913
2014
test/JsonSchemaSpec.hs+4−12
@@ -18,19 +18,11 @@ type FieldsSchema =
1818
1919type SchemaExample = 'SchemaObject FieldsSchema
2020
21−arrayData :: JsonRepr ArraySchema
22−arrayData = ReprArray [ReprNumber 13]
23−
24−arrayField :: FieldRepr ArrayField
25−arrayField = FieldRepr arrayData
26−
27−objectData :: Rec FieldRepr FieldsSchema
28−objectData = FieldRepr arrayData
29− :& FieldRepr (ReprOptional (Just (ReprText "foo")))
30− :& RNil
31−
3221exampleData :: JsonRepr SchemaExample
33−exampleData = ReprObject objectData
22+exampleData = withRepr @SchemaExample $
23+ field @"foo" [ReprNumber 13]
24+ <:&> field @"bar" (pure (ReprText "foo"))
25+ <:&> pure RNil
3426
3527spec :: Spec
3628spec = do
test/LensSpec.hs−6
@@ -1,7 +1,6 @@
11module LensSpec (spec, main) where
22
33import Control.Lens
4−import Data.Kind
54import Data.Proxy
65import Data.Schematic
76import Data.Vinyl
@@ -15,8 +14,6 @@ type ArrayField = '("foo", ArraySchema)
1514type FieldsSchema =
1615 '[ '("bar", 'SchemaOptional ('SchemaText '[ 'TEnum '["foo", "bar"]])), ArrayField]
1716
18−type SchemaExample = 'SchemaObject FieldsSchema
19−
2017arrayData :: JsonRepr ArraySchema
2118arrayData = ReprArray [ReprNumber 13]
2219
@@ -28,9 +25,6 @@ objectData = FieldRepr (ReprOptional (Just (ReprText "foo")))
2825 :& FieldRepr arrayData
2926 :& RNil
3027
31−exampleData :: JsonRepr SchemaExample
32−exampleData = ReprObject objectData
33−
3428type BigRecord = Rec FieldRepr
3529 '[ '("f1", 'SchemaNumber '[])
3630 , '("f2", 'SchemaNumber '[])
test/SchemaSpec.hs+2−8
@@ -14,8 +14,8 @@ type SchemaExample = 'SchemaObject
1414 '[ '("foo", 'SchemaArray '[ 'AEq 1] ('SchemaNumber '[ 'NGt 10]))
1515 , '("bar", 'SchemaOptional ('SchemaText '[ 'TEnum '["foo", "bar"]]))]
1616
17−example :: JsonRepr SchemaExample
18−example = withRepr @SchemaExample $
17+jsonExample :: JsonRepr SchemaExample
18+jsonExample = withRepr @SchemaExample $
1919 field @"bar" (Just $ ReprText "bar")
2020 <:&> field @"foo" [ReprNumber 12]
2121 <:&> pure RNil
@@ -27,12 +27,6 @@ type TestMigration =
2727
2828type VS = 'Versioned SchemaExample '[ TestMigration ]
2929
30−jsonExample :: JsonRepr SchemaExample
31−jsonExample = ReprObject $
32− FieldRepr (ReprArray [ReprNumber 12])
33− :& FieldRepr (ReprOptional (Just (ReprText "bar")))
34− :& RNil
35−
3630schemaJson :: ByteString
3731schemaJson = "{\"foo\": [13], \"bar\": null}"
3832