git.iko.soy/schematic
on c403036 help sign in
f5ed14a
swap
3 ahead, 47 behind
2 files changed+79−6
since splitsnapshots
unifiedsplit
src/Data/Schematic.hs+73 src/Data/Schematic/DSL.hs+6−6
src/Data/Schematic.hs+73
@@ -20,6 +20,7 @@ module Data.Schematic
2020 , ParseResult(..)
2121 , withRepr
2222 , field
23+ , bigSchema
2324 ) where
2425
2526import Control.Monad.Validation
@@ -37,6 +38,7 @@ import Data.Schematic.Validation
3738import Data.Singletons.Prelude hiding ((:.))
3839import Data.Tagged
3940import Data.Text as T
41+import Data.Vinyl
4042
4143
4244parseAndValidateJson
@@ -124,3 +126,74 @@ decodeAndValidateVersionedWithPureMList
124126 -> ParseResult (JsonRepr (Head (MapSnd (AllVersions versioned))))
125127decodeAndValidateVersionedWithPureMList a b c =
126128 runIdentity $ decodeAndValidateVersionedWithMList a b c
129+
130+type SText = SchemaText '[]
131+-- type SText = SchemaText '[TRegex "[0-9]+\\.[0-9]{2}"]
132+-- type SEnum = SchemaText '[TEnum '["one", "two", "three"]]
133+
134+type BigSchema = SchemaObject
135+ '[ '("1", SText)
136+ , '("2", SText)
137+ , '("3", SText)
138+ , '("4", SText)
139+ , '("5", SText)
140+ , '("6", SText)
141+ , '("7", SText)
142+ , '("8", SText)
143+ , '("9", SText)
144+ , '("10", SText)
145+ , '("11", SText)
146+ , '("12", SText)
147+ , '("13", SText)
148+ , '("14", SText)
149+ , '("15", SText)
150+ , '("16", SText)
151+ , '("17", SText)
152+ , '("18", SText)
153+ , '("19", SText)
154+ , '("20", SText)
155+ , '("21", SText)
156+ , '("22", SText)
157+ , '("23", SText)
158+ , '("24", SText)
159+ , '("25", SText)
160+ , '("26", SText)
161+ , '("27", SText)
162+ , '("28", SText)
163+ , '("29", SText)
164+ , '("30", SText)
165+ ]
166+
167+bigSchema :: JsonRepr BigSchema
168+bigSchema = withRepr @BigSchema
169+ $ field @"1" ""
170+ :& field @"2" ""
171+ :& field @"3" ""
172+ :& field @"4" ""
173+ :& field @"5" ""
174+ :& field @"6" ""
175+ :& field @"7" ""
176+ :& field @"8" ""
177+ :& field @"9" ""
178+ :& field @"10" ""
179+ :& field @"11" ""
180+ :& field @"12" ""
181+ :& field @"13" ""
182+ :& field @"14" ""
183+ :& field @"15" ""
184+ :& field @"16" ""
185+ :& field @"17" ""
186+ :& field @"18" ""
187+ :& field @"19" ""
188+ :& field @"20" ""
189+ :& field @"21" ""
190+ :& field @"22" ""
191+ :& field @"23" ""
192+ :& field @"24" ""
193+ :& field @"25" ""
194+ :& field @"26" ""
195+ :& field @"27" ""
196+ :& field @"28" ""
197+ :& field @"29" ""
198+ :& field @"30" ""
199+ :& RNil
src/Data/Schematic/DSL.hs+6−6
@@ -18,9 +18,9 @@ import Data.Vinyl.Functor
1818
1919
2020type Constructor a
21− = forall b. FSubset (FieldsOf a) b (FImage (FieldsOf a) b)
22− => Rec (Tagged (FieldsOf a) :. FieldRepr) b
23− -> JsonRepr ('SchemaObject (FieldsOf a))
21+ = forall fields b. (fields ~ FieldsOf a, FSubset fields b (FImage fields b))
22+ => Rec (Tagged fields :. FieldRepr) b
23+ -> JsonRepr ('SchemaObject fields)
2424
2525withRepr :: Constructor a
2626withRepr = ReprObject . rmap (unTagged . getCompose) . fcast
@@ -66,9 +66,9 @@ type family FieldsOf (s :: Schema) :: [(Symbol, Schema)] where
6666 FieldsOf ('SchemaObject fs) = fs
6767
6868type FieldConstructor fn =
69− forall fs. (Representable (ByField fn fs (FIndex fn fs)))
70− => Repr (ByField fn fs (FIndex fn fs))
71− -> (Tagged fs :. FieldRepr) '(fn, (ByField fn fs (FIndex fn fs)))
69+ forall byField fs. (byField ~ ByField fn fs (FIndex fn fs), Representable byField)
70+ => Repr byField
71+ -> (Tagged fs :. FieldRepr) '(fn, byField)
7272
7373field :: forall fn. KnownSymbol fn => FieldConstructor fn
7474field = Compose . Tagged . constructField (sing :: Sing fn) Proxy