ca48274 · typeable/schematic

git.iko.soy/typeable/schematic

on master help sign in

Snapshot

ca48274Denis Redozubov9 years ago

src/Data/Schematic/Schema.hs+11−38

compare with master

unifiedsplit

@@ -81,13 +81,13 @@ class SchemaConstructor jty where

81 constructor :: Proxy jty -> [CRepr jty] -> Schema

83instance SchemaConstructor 'JText where

84− constructor _ = Fix . SchemaText SJText

84+ constructor _ = Fix . SchemaText

86instance SchemaConstructor 'JNumber where

87− constructor _ = Fix . SchemaNumber SJNumber

87+ constructor _ = Fix . SchemaNumber

89instance SchemaConstructor 'JObject where

90− constructor _ = Fix . SchemaObject SJObject

90+ constructor _ = Fix . SchemaObject

92class Schematic ty where

93 type JT (ty :: k) :: JType

@@ -114,13 +114,16 @@ instance

114 build _ = constructor (Proxy @(JT (Field field ty cs)))

115 $ schema (Proxy @(JT (Field field ty cs))) (Proxy @cs)

116

117−data SObject els

117+data SObject typeName els

118

119+instance

120+ ( Verifiable 'JObject els

121+ , KnownSymbol typeName )

119−instance (Verifiable 'JObject els) => Schematic (SObject els) where

122+ => Schematic (SObject typeName els) where

120− type JT (SObject els) = 'JObject

123+ type JT (SObject typeName els) = 'JObject

121 build _ =

124 build _ =

122− constructor (Proxy @(JT (SObject els)))

125+ constructor (Proxy @(JT (SObject typeName els)))

123− $ schema (Proxy @(JT (SObject els))) (Proxy @els)

126+ $ schema (Proxy @(JT (SObject typeName els))) (Proxy @els)

124

127

125data SArray cs s

128data SArray cs s

126

129

@@ -131,39 +134,9 @@ instance

131 type JT (SArray cs s) = 'JArray

134 type JT (SArray cs s) = 'JArray

132 build _ =

135 build _ =

133 Fix $ SchemaArray

136 Fix $ SchemaArray

134− SJArray

135 (schema (Proxy @'JArray) (Proxy @cs))

137 (schema (Proxy @'JArray) (Proxy @cs))

136 (build (Proxy @s))

138 (build (Proxy @s))

137

139

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−

167-- | Shows it's top-level definition according to the json-schema

140-- | Shows it's top-level definition according to the json-schema

168class TopLevel spec

141class TopLevel spec

169

142

test/SchemaSpec.hs+13−24

@@ -14,47 +14,36 @@ type NumberSchema = SNumber '[ Gt 3]

14type ArraySchema = SArray '[ LengthEqNat 3 ] NumberSchema

16type ObjectSchema

17− = SObject

17+ = SObject "CarrierObj"

18 '[ Field "carrier" 'JText '[LengthEqNat 2]

19 , Field "number_gt_3" 'JNumber '[Gt 3] ]

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−

32spec :: Spec

21spec :: Spec

33spec = do

22spec = do

34 let

23 let

35− textSchema = Fix $ SchemaText SJText [LengthEq 2]

24+ textSchema = Fix $ SchemaText [LengthEq 2]

36− numberSchema = Fix $ SchemaNumber SJNumber [Gt 3]

25+ numberSchema = Fix $ SchemaNumber [Gt 3]

37− arraySchema = Fix $ SchemaArray SJArray [LengthArrEq 3]

26+ arraySchema = Fix $ SchemaArray [LengthArrEq 3]

38− $ Fix $ SchemaNumber SJNumber [Gt 3]

27+ $ Fix $ SchemaNumber [Gt 3]

39− objectSchema = Fix $ SchemaObject SJObject

28+ objectSchema = Fix $ SchemaObject

40 [ ("carrier", textSchema)

29 [ ("carrier", textSchema)

41 , ("number_gt_3", numberSchema)]

30 , ("number_gt_3", numberSchema)]

43 describe "Schema translation: " $ do

32 describe "Schema translation: " $ do

44− it "translate string schema"

33+ it "translate string schema" $ do

45− $ build (Proxy @TextSchema) `shouldBe` textSchema

34+ build (Proxy @TextSchema) `shouldBe` textSchema

46− it "translates number schema"

35+ it "translates number schema" $ do

47− $ build (Proxy @NumberSchema) `shouldBe` numberSchema

36+ build (Proxy @NumberSchema) `shouldBe` numberSchema

48 it "translates array schema" $ do

37 it "translates array schema" $ do

49 build (Proxy @ArraySchema) `shouldBe` arraySchema

38 build (Proxy @ArraySchema) `shouldBe` arraySchema

50 it "translates object schema" $ do

39 it "translates object schema" $ do

51 build (Proxy @ObjectSchema) `shouldBe` objectSchema

40 build (Proxy @ObjectSchema) `shouldBe` objectSchema

52− it "translates Generate symbols" $ do

41+ -- it "translates Generate symbols" $ do

53− build (Proxy @GeneratorSchema) `shouldBe` objectSchema

42+ -- build (Proxy @GeneratorSchema) `shouldBe` objectSchema

55 describe "Types listing: " $ do

44 describe "Types listing: " $ do

56 it "lists types"

45 it "lists types"

57− $ typesOf (build (Proxy @BiggerSchema))

46+ $ typesOf (build (Proxy @ObjectSchema))

58 `shouldBe` [("Carrier", textSchema), ("Object", objectSchema)]

47 `shouldBe` [("Carrier", textSchema), ("Object", objectSchema)]

60main :: IO ()

49main :: IO ()