git.iko.soy/schematic
on master help sign in
new mess
c73af44Denis Redozubov
schematic.cabal+7
compare with master
unifiedsplit
@@ -18,10 +18,12 @@ cabal-version: >=1.10
18library
18library
19 exposed-modules: Data.Schematic
19 exposed-modules: Data.Schematic
20 , Data.Schematic.Schema
20 , Data.Schematic.Schema
21+ , Data.Schematic.Validation
21 -- ghc-options:
22 -- ghc-options:
22 -- other-modules:
23 -- other-modules:
23 default-extensions: ConstraintKinds
24 default-extensions: ConstraintKinds
24 , DataKinds
25 , DataKinds
26+ , DefaultSignatures
25 , DeriveFunctor
27 , DeriveFunctor
26 , DeriveFoldable
28 , DeriveFoldable
27 , DeriveDataTypeable
29 , DeriveDataTypeable
@@ -31,12 +33,15 @@ library
31 , GADTs
33 , GADTs
32 , KindSignatures
34 , KindSignatures
33 , InstanceSigs
35 , InstanceSigs
36+ , LambdaCase
34 , MultiParamTypeClasses
37 , MultiParamTypeClasses
35 , OverloadedStrings
38 , OverloadedStrings
36 , PolyKinds
39 , PolyKinds
37 , QuasiQuotes
40 , QuasiQuotes
38 , PartialTypeSignatures
41 , PartialTypeSignatures
42+ , RankNTypes
39 , RecordWildCards
43 , RecordWildCards
44+ , StandaloneDeriving
40 , ScopedTypeVariables
45 , ScopedTypeVariables
41 , TemplateHaskell
46 , TemplateHaskell
42 , TypeApplications
47 , TypeApplications
@@ -44,8 +49,10 @@ library
44 , TypeInType
49 , TypeInType
45 , TypeOperators
50 , TypeOperators
46 , TypeSynonymInstances
51 , TypeSynonymInstances
52+ , UndecidableInstances
47 build-depends: base >=4.9 && <4.10
53 build-depends: base >=4.9 && <4.10
48 , regex-compat
54 , regex-compat
55+ , singletons
49 , text
56 , text
50 , vinyl
57 , vinyl
51 hs-source-dirs: src
58 hs-source-dirs: src
src/Data/Schematic/Schema.hs+5−49
@@ -8,28 +8,11 @@ module Data.Schematic.Schema where
8
8
9import Data.Kind hiding (Type)
9import Data.Kind hiding (Type)
10import Data.Proxy
10import Data.Proxy
11+import Data.Schematic.Validation
11import Data.Text (Text)
12import Data.Text (Text)
12import GHC.TypeLits (KnownNat, natVal, KnownSymbol, symbolVal, Symbol, Nat)
13import GHC.TypeLits (KnownNat, natVal, KnownSymbol, symbolVal, Symbol, Nat)
13
14
14
15
15−-- | Type Tags
16−data JType
17− = JText
18− | JNumber
19− | JArray
20− | JObject
21− | JNull
22−
23−type family Repr (ty :: JType) :: * where
24− Repr 'JText = String -- because of matchRegex
25− Repr 'JNumber = Double
26−
27−type family CRepr (jty :: JType) :: * where
28− CRepr JText = TextConstraint
29− CRepr JNumber = NumberConstraint
30− CRepr JObject = (String, Schema)
31− CRepr JArray = ArrayConstraint
32−
33class Constrained (ty :: JType) c where
16class Constrained (ty :: JType) c where
34 cRep :: Proxy ty -> Proxy c -> CRepr ty
17 cRep :: Proxy ty -> Proxy c -> CRepr ty
35
18
@@ -92,45 +75,17 @@ instance
92 fieldName = symbolVal (Proxy @field)
75 fieldName = symbolVal (Proxy @field)
93 fieldSchema = constructor (Proxy @jty) $ schema (Proxy @jty) (Proxy @cs)
76 fieldSchema = constructor (Proxy @jty) $ schema (Proxy @jty) (Proxy @cs)
94
77
95−data TextConstraint
96− = LengthEq Integer
97− | LengthLe Integer
98− | LengthGt Integer
99− deriving (Show, Eq)
100−
101−data NumberConstraint
102− = Le Integer
103− | Gt Integer
104− | Eq Integer
105− deriving (Show, Eq)
106−
107−data ArrayConstraint
108− = LengthArrEq Integer
109− deriving (Show, Eq)
110−
111−data Schema
112− = SchemaText [TextConstraint]
113− | SchemaNumber [NumberConstraint]
114− | SchemaObject [(String, Schema)]
115− | SchemaArray [ArrayConstraint] Schema
116− deriving (Show, Eq)
117−
118−-- | Apply constraint for each element of list
119−-- type family AllSatisfy (c :: k -> Constraint) (s :: [k]) :: Constraint where
120−-- AllSatisfy c '[] = ()
121−-- AllSatisfy c (a ': as) = (c a, AllSatisfy c as)
122−
123class SchemaConstructor jty where
78class SchemaConstructor jty where
124 constructor :: Proxy jty -> [CRepr jty] -> Schema
79 constructor :: Proxy jty -> [CRepr jty] -> Schema
125
80
126instance SchemaConstructor 'JText where
81instance SchemaConstructor 'JText where
127− constructor _ = SchemaText
82+ constructor _ = SchemaText SJText
128
83
129instance SchemaConstructor 'JNumber where
84instance SchemaConstructor 'JNumber where
130− constructor _ = SchemaNumber
85+ constructor _ = SchemaNumber SJNumber
131
86
132instance SchemaConstructor 'JObject where
87instance SchemaConstructor 'JObject where
133− constructor _ = SchemaObject
88+ constructor _ = SchemaObject SJObject
134
89
135class Schematic ty where
90class Schematic ty where
136 type JT (ty :: k) :: JType
91 type JT (ty :: k) :: JType
@@ -174,6 +129,7 @@ instance
174 type JT (SArray cs s) = 'JArray
129 type JT (SArray cs s) = 'JArray
175 build _ =
130 build _ =
176 SchemaArray
131 SchemaArray
132+ SJArray
177 (schema (Proxy @'JArray) (Proxy @cs))
133 (schema (Proxy @'JArray) (Proxy @cs))
178 (build (Proxy @s))
134 (build (Proxy @s))
179
135