8b92be8 · typeable/schematic

git.iko.soy/typeable/schematic

on master help sign in

Union validation attempt

8b92be8Denis Redozubov8 years ago

src/Data/Schematic/Validation.hs+16−2

@@ -10,6 +10,7 @@ import Data.Aeson.Types

10import Data.Coerce

11import Data.Foldable

12import Data.Functor.Identity

13+import Data.Kind

13import Data.Monoid

14import Data.Monoid

14import Data.Schematic.Path

15import Data.Schematic.Path

15import Data.Schematic.Schema

16import Data.Schematic.Schema

@@ -241,8 +242,21 @@ instance SingI (SchemaObject s) => Validatable (SchemaObject s) where

241 $ lookaheadJsonRepr newPath d

242 $ lookaheadJsonRepr newPath d

242 go ftl

243 go ftl

243

244

245+instance

246+ (SingI (SchemaUnion (s ': tl)))

244−instance SingI (SchemaUnion s) => Validatable (SchemaUnion s) where

247+ => Validatable (SchemaUnion (s ': tl)) where

245− validateJsonRepr dpath (ReprUnion u) = pure ()

248+ validateJsonRepr dpath (ReprUnion u) = do

249+ let

250+ v :: forall s. Sing s -> JsonRepr s -> Const (Validation ()) s

251+ v s j = withSingI s $ Const $ lookaheadJsonRepr dpath j

252+ peel :: Union (Const (Validation ())) ts -> Validation ()

253+ peel (That u) = peel u

254+ peel (This v) = getConst v

255+ umap' :: (forall a . Sing a -> f a -> g a) -> SList as -> Union f as -> Union g as

256+ umap' f (SCons s' stl') = \case

257+ This a -> This (f s' a)

258+ That u -> That (umap' f stl' u)

259+ peel (umap' v sing u)

246

260

247 -- ReprUnion u -> do

261 -- ReprUnion u -> do

248 -- let

262 -- let