1190166 · schematic · git.iko.soy

src/Data/Schematic/Schema.hs+1−14

compare with master

unifiedsplit

@@ -331,20 +331,9 @@ data JsonRepr :: Schema -> Type where

331 ReprArray :: V.Vector (JsonRepr s) -> JsonRepr ('SchemaArray cs s)

332 ReprObject :: Rec FieldRepr fs -> JsonRepr ('SchemaObject fs)

333 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))

338

335

339-- | Move to the union package

336-- | 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−

348instance Show (JsonRepr ('SchemaText cs)) where

337instance Show (JsonRepr ('SchemaText cs)) where

349 show (ReprText t) = "ReprText " P.++ show t

338 show (ReprText t) = "ReprText " P.++ show t

350

339

@@ -362,8 +351,6 @@ instance V.RecAll FieldRepr fs Show => Show (JsonRepr ('SchemaObject fs)) where

362instance Show (JsonRepr s) => Show (JsonRepr ('SchemaOptional s)) where

351instance Show (JsonRepr s) => Show (JsonRepr ('SchemaOptional s)) where

363 show (ReprOptional s) = "ReprOptional " P.++ show s

352 show (ReprOptional s) = "ReprOptional " P.++ show s

364

353

365−deriving instance UnionAll f as Show => Show (Union f as)

366−

367instance (Monad m, Serial m Text)

354instance (Monad m, Serial m Text)

368 => Serial m (JsonRepr ('SchemaText cs)) where

355 => Serial m (JsonRepr ('SchemaText cs)) where

369 series = cons1 ReprText

356 series = cons1 ReprText

src/Data/Schematic/Validation.hs+1−1

@@ -207,7 +207,7 @@ validateJsonRepr sschema dpath jr = case jr of

207 let newPath = dpath <> [DKey (knownFieldName f)]

208 validateJsonRepr (knownFieldSchema f) newPath d

209 go ftl

210− ReprUnion u -> pure ()

210+ ReprUnion _ -> pure () -- FIXME

211 -- case sschema of

212 -- SSchemaUnion ss -> case ss of

213 -- SCons s stl -> case umatch' s u of

test/HelpersSpec.hs−6

@@ -3,18 +3,12 @@

3module HelpersSpec (spec, main) where

4

5import Control.Lens

6−import Data.Aeson

7−import Data.ByteString.Char8 as C8

8−import Data.ByteString.Lazy as BL

9import Data.ByteString.Lazy.Lens

6import Data.ByteString.Lazy.Lens

10import Data.Foldable

7import Data.Foldable

11−import Data.Functor.Identity

12import Data.Monoid

8import Data.Monoid

13−import Data.Proxy

14import Data.Schematic

9import Data.Schematic

15import Data.Text as T

10import Data.Text as T

16import Data.Text.Lens

11import Data.Text.Lens

17−import Data.Vinyl

18import Test.Hspec

12import Test.Hspec

19

13

20

14

test/JsonSchemaSpec.hs+4−12

@@ -18,19 +18,11 @@ type FieldsSchema =

18

19type SchemaExample = 'SchemaObject FieldsSchema

20

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−

32exampleData :: JsonRepr SchemaExample

21exampleData :: JsonRepr SchemaExample

33−exampleData = ReprObject objectData

22+exampleData = withRepr @SchemaExample $

23+ field @"foo" [ReprNumber 13]

24+ <:&> field @"bar" (pure (ReprText "foo"))

25+ <:&> pure RNil

34

26

35spec :: Spec

27spec :: Spec

36spec = do

28spec = do

test/LensSpec.hs−6

@@ -1,7 +1,6 @@

1module LensSpec (spec, main) where

2

3import Control.Lens

4−import Data.Kind

5import Data.Proxy

4import Data.Proxy

6import Data.Schematic

5import Data.Schematic

7import Data.Vinyl

6import Data.Vinyl

@@ -15,8 +14,6 @@ type ArrayField = '("foo", ArraySchema)

15type FieldsSchema =

14type FieldsSchema =

16 '[ '("bar", 'SchemaOptional ('SchemaText '[ 'TEnum '["foo", "bar"]])), ArrayField]

15 '[ '("bar", 'SchemaOptional ('SchemaText '[ 'TEnum '["foo", "bar"]])), ArrayField]

17

16

18−type SchemaExample = 'SchemaObject FieldsSchema

19−

20arrayData :: JsonRepr ArraySchema

17arrayData :: JsonRepr ArraySchema

21arrayData = ReprArray [ReprNumber 13]

18arrayData = ReprArray [ReprNumber 13]

22

19

@@ -28,9 +25,6 @@ objectData = FieldRepr (ReprOptional (Just (ReprText "foo")))

28 :& FieldRepr arrayData

25 :& FieldRepr arrayData

29 :& RNil

26 :& RNil

30

27

31−exampleData :: JsonRepr SchemaExample

32−exampleData = ReprObject objectData

33−

34type BigRecord = Rec FieldRepr

28type BigRecord = Rec FieldRepr

35 '[ '("f1", 'SchemaNumber '[])

29 '[ '("f1", 'SchemaNumber '[])

36 , '("f2", 'SchemaNumber '[])

30 , '("f2", 'SchemaNumber '[])

test/SchemaSpec.hs+2−8

@@ -14,8 +14,8 @@ type SchemaExample = 'SchemaObject

14 '[ '("foo", 'SchemaArray '[ 'AEq 1] ('SchemaNumber '[ 'NGt 10]))

15 , '("bar", 'SchemaOptional ('SchemaText '[ 'TEnum '["foo", "bar"]]))]

16

17−example :: JsonRepr SchemaExample

17+jsonExample :: JsonRepr SchemaExample

18−example = withRepr @SchemaExample $

18+jsonExample = withRepr @SchemaExample $

19 field @"bar" (Just $ ReprText "bar")

20 <:&> field @"foo" [ReprNumber 12]

21 <:&> pure RNil

@@ -27,12 +27,6 @@ type TestMigration =

27

28type VS = 'Versioned SchemaExample '[ TestMigration ]

29

30−jsonExample :: JsonRepr SchemaExample

31−jsonExample = ReprObject $

32− FieldRepr (ReprArray [ReprNumber 12])

33− :& FieldRepr (ReprOptional (Just (ReprText "bar")))

34− :& RNil

35−

36schemaJson :: ByteString

30schemaJson :: ByteString

37schemaJson = "{\"foo\": [13], \"bar\": null}"

31schemaJson = "{\"foo\": [13], \"bar\": null}"

38

32