@@ -1,76 +0,0 @@
1−{-# LANGUAGE AllowAmbiguousTypes #-}
2−
3−module Data.Schematic.Schema where
4−
5−import Data.Maybe
6−import Data.Proxy
7−import GHC.TypeLits
8−import Text.Regex
9−
10−
11−-- JSON types
12−data JText
13−data JNumber
14−data JArray
15−data JObject
16−data JNull
17−
18−type family Repr (ty :: k1) :: k2 where
19− Repr JText = String -- because of matchRegex
20− Repr JNumber = Double
21−
22−class Schema schema where
23− type Term subschema
24− predicate :: Repr (Term ty) -> Bool
25−
26−data Regexp (s :: Symbol) = Regexp
27−
28−instance KnownSymbol reg => Schema (Regexp reg) subschema where
29− type Term (Regexp reg) subschema = Term ((), subschema)
30− predicate = isJust . matchRegex (mkRegex $ symbolVal (Proxy :: Proxy reg))
31−
32−data LengthEqNat (n :: Nat)
33−data LengthGtNat (n :: Nat)
34−data LengthGeNat (n :: Nat)
35−data LengthLtNat (n :: Nat)
36−data LengthLeNat (n :: Nat)
37−
38−instance KnownNat n => Schema (LengthEqNat n) subschema where
39− type Term (LengthEqNat n) s = Term s
40− predicate s = natVal (Proxy :: Proxy n) == fromIntegral (length s)
41− && predicate
42−
43−instance KnownNat n => Schema (LengthGtNat n) rest where
44− type Term (LengthGtNat n) = JNumber
45− predicate s = natVal (Proxy :: Proxy n) > fromIntegral (length s)
46−
47−instance KnownNat n => Schema (LengthGeNat n) rest where
48− type Term (LengthGeNat n) = JNumber
49− predicate s = natVal (Proxy :: Proxy n) >= fromIntegral (length s)
50−
51−instance KnownNat n => Schema (LengthLtNat n) rest where
52− type Term (LengthLtNat n) = JNumber
53− predicate s = natVal (Proxy :: Proxy n) < fromIntegral (length s)
54−
55−instance KnownNat n => Schema (LengthLeNat n) rest where
56− type Term (LengthLeNat n) = JNumber
57− predicate s = natVal (Proxy :: Proxy n) <= fromIntegral (length s)
58−
59−-- | Corresponds to [] or {} json values.
60−data EmptyObj = EmptyObj
61−
62−data ConsObj (s :: Symbol) jsval = ConsObj
63−
64−-- data Schema a where
65−-- (:*:) :: KnownSymbol label => label -> Schema l -> Schema r -> Schema a
66−-- (:%:) :: Schema c a => Schema a -> c a -> Schema a
67−-- Nil :: Schema a
68−
69−data (s :: Symbol) :+: obj = (:+:) a b
70−
71−infixl 6 :+:
72−infixl 6 :*:
73−infixl 9 :%:
74−
75−schema :: Schema ()
76−schema = "foo" :%: (Regexp "foo") :*: Nil