git.iko.soy/schematic
on master help sign in
Snapshot
commitca4827431d3573ff0ce62c0bcb459020e7a6a9fc authorDenis Redozubov <denis.redozubov@gmail.com> dateWed 17 May 2017, 11:26 (9 years ago) parent7dd75d3
2 files changed+24−62
compare with master
unifiedsplit
src/Data/Schematic/Schema.hs+11−38 test/SchemaSpec.hs+13−24
src/Data/Schematic/Schema.hs+11−38
@@ -81,13 +81,13 @@ class SchemaConstructor jty where
8181 constructor :: Proxy jty -> [CRepr jty] -> Schema
8282
8383instance SchemaConstructor 'JText where
84− constructor _ = Fix . SchemaText SJText
84+ constructor _ = Fix . SchemaText
8585
8686instance SchemaConstructor 'JNumber where
87− constructor _ = Fix . SchemaNumber SJNumber
87+ constructor _ = Fix . SchemaNumber
8888
8989instance SchemaConstructor 'JObject where
90− constructor _ = Fix . SchemaObject SJObject
90+ constructor _ = Fix . SchemaObject
9191
9292class Schematic ty where
9393 type JT (ty :: k) :: JType
@@ -114,13 +114,16 @@ instance
114114 build _ = constructor (Proxy @(JT (Field field ty cs)))
115115 $ schema (Proxy @(JT (Field field ty cs))) (Proxy @cs)
116116
117−data SObject els
117+data SObject typeName els
118118
119−instance (Verifiable 'JObject els) => Schematic (SObject els) where
120− type JT (SObject els) = 'JObject
119+instance
120+ ( Verifiable 'JObject els
121+ , KnownSymbol typeName )
122+ => Schematic (SObject typeName els) where
123+ type JT (SObject typeName els) = 'JObject
121124 build _ =
122− constructor (Proxy @(JT (SObject els)))
123− $ schema (Proxy @(JT (SObject els))) (Proxy @els)
125+ constructor (Proxy @(JT (SObject typeName els)))
126+ $ schema (Proxy @(JT (SObject typeName els))) (Proxy @els)
124127
125128data SArray cs s
126129
@@ -131,39 +134,9 @@ instance
131134 type JT (SArray cs s) = 'JArray
132135 build _ =
133136 Fix $ SchemaArray
134− SJArray
135137 (schema (Proxy @'JArray) (Proxy @cs))
136138 (build (Proxy @s))
137139
138−data Generate name ty
139−
140−instance
141− ( Verifiable JText cs
142− , KnownSymbol name, Schematic ty )
143− => Schematic (Generate name (SText cs)) where
144− type JT (Generate name (SText cs)) = JT (SText cs)
145− build _ = build (Proxy @(SText cs))
146−
147−instance
148− ( Verifiable JNumber cs
149− , KnownSymbol name, Schematic ty )
150− => Schematic (Generate name (SNumber cs)) where
151− type JT (Generate name (SNumber cs)) = JT (SNumber cs)
152− build _ = build (Proxy @(SNumber cs))
153−
154−instance
155− ( Verifiable JArray cs
156− , Schematic s )
157− => Schematic (Generate name (SArray cs s)) where
158− type JT (Generate name (SArray cs s)) = JT (SArray cs s)
159− build _ = build (Proxy @(SArray cs s))
160−
161−instance
162− (Verifiable JObject els)
163− => Schematic (Generate name (SObject els)) where
164− type JT (Generate name (SObject els)) = JT (SObject els)
165− build _ = build (Proxy @(SObject els))
166−
167140-- | Shows it's top-level definition according to the json-schema
168141class TopLevel spec
169142
test/SchemaSpec.hs+13−24
@@ -14,47 +14,36 @@ type NumberSchema = SNumber '[ Gt 3]
1414type ArraySchema = SArray '[ LengthEqNat 3 ] NumberSchema
1515
1616type ObjectSchema
17− = SObject
17+ = SObject "CarrierObj"
1818 '[ Field "carrier" 'JText '[LengthEqNat 2]
1919 , Field "number_gt_3" 'JNumber '[Gt 3] ]
2020
21−type GeneratorSchema
22− = SObject
23− '[ Generate "Carrier" (Field "carrier" 'JText '[LengthEqNat 2])
24− , Field "number_gt_3" 'JNumber '[Gt 3] ]
25−
26−type BiggerSchema
27− = Generate "Object"
28− ( SObject
29− '[ Generate "Carrier" (Field "carrier" 'JText '[LengthEqNat 2])
30− , Field "number_gt_3" 'JNumber '[Gt 3] ])
31−
3221spec :: Spec
3322spec = do
3423 let
35− textSchema = Fix $ SchemaText SJText [LengthEq 2]
36− numberSchema = Fix $ SchemaNumber SJNumber [Gt 3]
37− arraySchema = Fix $ SchemaArray SJArray [LengthArrEq 3]
38− $ Fix $ SchemaNumber SJNumber [Gt 3]
39− objectSchema = Fix $ SchemaObject SJObject
24+ textSchema = Fix $ SchemaText [LengthEq 2]
25+ numberSchema = Fix $ SchemaNumber [Gt 3]
26+ arraySchema = Fix $ SchemaArray [LengthArrEq 3]
27+ $ Fix $ SchemaNumber [Gt 3]
28+ objectSchema = Fix $ SchemaObject
4029 [ ("carrier", textSchema)
4130 , ("number_gt_3", numberSchema)]
4231
4332 describe "Schema translation: " $ do
44− it "translate string schema"
45− $ build (Proxy @TextSchema) `shouldBe` textSchema
46− it "translates number schema"
47− $ build (Proxy @NumberSchema) `shouldBe` numberSchema
33+ it "translate string schema" $ do
34+ build (Proxy @TextSchema) `shouldBe` textSchema
35+ it "translates number schema" $ do
36+ build (Proxy @NumberSchema) `shouldBe` numberSchema
4837 it "translates array schema" $ do
4938 build (Proxy @ArraySchema) `shouldBe` arraySchema
5039 it "translates object schema" $ do
5140 build (Proxy @ObjectSchema) `shouldBe` objectSchema
52− it "translates Generate symbols" $ do
53− build (Proxy @GeneratorSchema) `shouldBe` objectSchema
41+ -- it "translates Generate symbols" $ do
42+ -- build (Proxy @GeneratorSchema) `shouldBe` objectSchema
5443
5544 describe "Types listing: " $ do
5645 it "lists types"
57− $ typesOf (build (Proxy @BiggerSchema))
46+ $ typesOf (build (Proxy @ObjectSchema))
5847 `shouldBe` [("Carrier", textSchema), ("Object", objectSchema)]
5948
6049main :: IO ()