ec1996d · typeable/schematic

git.iko.soy/typeable/schematic

compilation workaround

commitec1996d4e2a53af0b5d0afef16a65854ab00b86b authorDenis Redozubov <denis.redozubov@gmail.com> dateMon 9 Oct 2017, 12:14 (9 years ago) parent9accf73

2 files changed+19−8

compare with master

unifiedsplit

src/Data/Schematic/Schema.hs+1−1 src/Data/Schematic/Validation.hs+18−7

src/Data/Schematic/Schema.hs+1−1

@@ -327,7 +327,7 @@ data JsonRepr :: Schema -> Type where

327327 ReprArray :: V.Vector (JsonRepr s) -> JsonRepr ('SchemaArray cs s)

328328 ReprObject :: Rec FieldRepr fs -> JsonRepr ('SchemaObject fs)

329329 ReprOptional :: Maybe (JsonRepr s) -> JsonRepr ('SchemaOptional s)

330− ReprUnion :: Union JsonRepr s -> JsonRepr ('SchemaUnion ss)

330+ ReprUnion :: Union JsonRepr (h ': tl) -> JsonRepr ('SchemaUnion (h ': tl))

331331

332332-- | Move to the different package

333333type family UnionAll (f :: u -> *) (rs :: [u]) (c :: * -> Constraint) :: Constraint where

src/Data/Schematic/Validation.hs+18−7

@@ -206,10 +206,21 @@ validateJsonRepr sschema dpath jr = case jr of

206206 let newPath = dpath <> [DKey (knownFieldName f)]

207207 validateJsonRepr (knownFieldSchema f) newPath d

208208 go ftl

209− ReprUnion u -> case sschema of

210− SSchemaUnion ss -> case ss of

211− SNil -> vWarning $ mmSingleton (demotedPathToText dpath)

212− $ pure "union handling error, please report this as bug"

213− SCons s stl -> case u of

214− This x -> validateJsonRepr s dpath x

215− That u' -> validateJsonRepr (SSchemaUnion ss) dpath (ReprUnion u')

209+ ReprUnion u -> pure () -- case sschema of

210+ -- SSchemaUnion ss -> case ss of

211+ -- SNil -> do

212+ -- let JSONPath path = demotedPathToText dpath

213+ -- void $ vWarning $ mmSingleton path

214+ -- $ pure "union handling error, please report this as bug"

215+ -- SCons s stl -> case umatch' s u of

216+ -- Nothing -> case urestrict u of

217+ -- Nothing -> fail "impossible to urestrict union, please report this as a bug"

218+ -- Just x -> do

219+ -- let

220+ -- toUnion :: Sing ss -> Union JsonRepr ss -> JsonRepr ('SchemaUnion ss)

221+ -- toUnion _ = ReprUnion

222+ -- validateJsonRepr (SSchemaUnion stl) dpath $ toUnion stl x

223+ -- Just x -> validateJsonRepr s dpath x

224+

225+umatch' :: UElem a as i => Sing a -> Union f as -> Maybe (f a)

226+umatch' _ u = umatch u