git.iko.soy/typeable/schematic
on master help sign in
kinda works
a4c8457Denis Redozubov
src/Data/Schematic/Schema.hs+23−25
compare with master
unifiedsplit
@@ -1,7 +1,6 @@
1{-# LANGUAGE AllowAmbiguousTypes #-}
1{-# LANGUAGE AllowAmbiguousTypes #-}
2{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE InstanceSigs #-}
3{-# LANGUAGE InstanceSigs #-}
4−{-# LANGUAGE TypeInType #-}
5{-# LANGUAGE UndecidableInstances #-}
4{-# LANGUAGE UndecidableInstances #-}
6{-# OPTIONS_GHC -fprint-explicit-kinds #-}
5{-# OPTIONS_GHC -fprint-explicit-kinds #-}
7
6
@@ -21,7 +20,6 @@ data JType
21 | JObject
20 | JObject
22 | JNull
21 | JNull
23
22
24−
25type family Repr (ty :: JType) :: * where
23type family Repr (ty :: JType) :: * where
26 Repr 'JText = String -- because of matchRegex
24 Repr 'JText = String -- because of matchRegex
27 Repr 'JNumber = Double
25 Repr 'JNumber = Double
@@ -45,37 +43,38 @@ instance KnownNat nat => Constrained 'JNumber (Gt nat) where
45
43
46data Field field ty schema
44data Field field ty schema
47
45
48−instance (SchemaConstructor (JT jty), Verifiable (JT jty) cs, KnownSymbol field)
49− => Constrained JObject (Field field ty cs) where
50− cRep _ _ =
51− (symbolVal (Proxy @field), constructor (Proxy @(JT jty))
52− $ schema (Proxy @(JT jty)) (Proxy @cs))
53−
54data Empty
46data Empty
55
47
56class Verifiable ty cs where
48class Verifiable ty cs where
57 schema :: Proxy ty -> Proxy cs -> [CRepr ty]
49 schema :: Proxy ty -> Proxy cs -> [CRepr ty]
58
50
59instance
51instance
52+ ( Constrained 'JText c
53+ , Verifiable 'JText cs )
60− (Constrained 'JText c, Verifiable 'JText cs) => Verifiable 'JText (c ': cs) where
54+ => Verifiable 'JText (c ': cs) where
61− schema _ _ = cRep (Proxy @'JText) (Proxy @c) : schema (Proxy @'JText) (Proxy @cs)
55+ schema _ _ = cRep (Proxy @'JText) (Proxy @c)
56+ : schema (Proxy @'JText) (Proxy @cs)
62
57
63instance
58instance
59+ ( Constrained 'JNumber c
60+ , Verifiable 'JNumber cs )
64− (Constrained 'JNumber c, Verifiable 'JNumber cs) => Verifiable 'JNumber (c ': cs) where
61+ => Verifiable 'JNumber (c ': cs) where
65− schema _ _ = cRep (Proxy @'JNumber) (Proxy @c) : schema (Proxy @'JNumber) (Proxy @cs)
62+ schema _ _ = cRep (Proxy @'JNumber) (Proxy @c)
63+ : schema (Proxy @'JNumber) (Proxy @cs)
66
64
67instance Verifiable jty '[] where
65instance Verifiable jty '[] where
68 schema _ _ = []
66 schema _ _ = []
69
67
70instance
68instance
69+ ( SchemaConstructor jty
71− (Constrained 'JObject c, Verifiable 'JObject cs, KnownSymbol field)
70+ , Verifiable 'JObject fs
71+ , KnownSymbol field
72+ , Verifiable jty cs )
72− => Verifiable 'JObject ((Field field jty c) ': cs) where
73+ => Verifiable 'JObject ((Field field jty cs) ': fs) where
73− schema _ _ = cRep (Proxy @'JObject) (Proxy @c) : schema (Proxy @'JObject) (Proxy @cs)
74+ schema _ _ = (fieldName, fieldSchema) : schema (Proxy @'JObject) (Proxy @fs)
74−
75+ where
75−-- type family VerifiableFields (ty :: JType) (els :: [k]) :: Constraint where
76+ fieldName = symbolVal (Proxy @field)
76−-- VerifiableFields ty '[] = ()
77+ fieldSchema = constructor (Proxy @jty) $ schema (Proxy @jty) (Proxy @cs)
77−-- VerifiableFields ty ((Field f jty s) ': elss)
78−-- = (Verifiable jty s, VerifiableFields ty elss)
79
78
80type family CRepr (jty :: JType) :: * where
79type family CRepr (jty :: JType) :: * where
81 CRepr JText = TextConstraint
80 CRepr JText = TextConstraint
@@ -102,9 +101,9 @@ data Schema
102 deriving (Show, Eq)
101 deriving (Show, Eq)
103
102
104-- | Apply constraint for each element of list
103-- | Apply constraint for each element of list
105−type family AllSatisfy (c :: k -> Constraint) (s :: [k]) :: Constraint where
104+-- type family AllSatisfy (c :: k -> Constraint) (s :: [k]) :: Constraint where
106− AllSatisfy c '[] = ()
105+-- AllSatisfy c '[] = ()
107− AllSatisfy c (a ': as) = (c a, AllSatisfy c as)
106+-- AllSatisfy c (a ': as) = (c a, AllSatisfy c as)
108
107
109class SchemaConstructor jty where
108class SchemaConstructor jty where
110 constructor :: Proxy jty -> [CRepr jty] -> Schema
109 constructor :: Proxy jty -> [CRepr jty] -> Schema
@@ -141,8 +140,7 @@ instance (Verifiable (JT ty) cs, SchemaConstructor (JT ty)) => Schematic (Field
141
140
142data SObject els
141data SObject els
143
142
144−instance (els ~ '[k], Verifiable 'JObject els, AllSatisfy Schematic els)
145− => Schematic (SObject els) where
143+instance (Verifiable 'JObject els) => Schematic (SObject els) where
146 type JT (SObject els) = 'JObject
144 type JT (SObject els) = 'JObject
147 build _ =
145 build _ =
148 constructor (Proxy @(JT (SObject els)))
146 constructor (Proxy @(JT (SObject els)))
test/SchemaSpec.hs+3−2
@@ -4,11 +4,12 @@ import Data.Proxy
4import Data.Schematic.Schema
4import Data.Schematic.Schema
5import Test.Hspec
5import Test.Hspec
6
6
7−type TextSchema = SText '[LengthEqNat 3]
7+type TextSchema = SText '[LengthEqNat 2]
8
8
9type NumberSchema = SNumber '[ Gt 3]
9type NumberSchema = SNumber '[ Gt 3]
10
10
11−type ObjectSchema = SObject '[ Field "carrier" 'JText [TextSchema] ]
11+type ObjectSchema
12+ = SObject '[ Field "carrier" 'JText '[LengthEqNat 2], Field "number_gt_3" 'JNumber '[Gt 3] ]
12
13
13spec :: Spec
14spec :: Spec
14spec = do
15spec = do