@@ -1,82 +0,0 @@
1−module Data.Aeson.Validation where
4−import Control.Applicative
6−import Data.Aeson.Types as J
7−import Data.Foldable as F
8−import Data.HashMap.Strict as H
11−import Data.Schematic.Schema
12−import Data.Singletons
13−import Data.Singletons.Decide
15−import Data.Traversable
17−(<&&>) :: Applicative f => f Bool -> f Bool -> f Bool
28−-- validateConstraint s c = \case
29−-- J.String t -> case s %~ SJText of
30−-- Proved Refl -> pure $ case fromSing c of
31−-- TEq n -> (== n) . fromIntegral . T.length $ t
32−-- TLe n -> (<= n) . fromIntegral . T.length $ t
33−-- TGt n -> (> n) . fromIntegral . T.length $ t
34−-- Disproved _ -> mzero
35−-- J.Number i -> case s %~ SJNumber of
36−-- Proved Refl -> pure $ case fromSing c of
37−-- NEq n -> i == fromIntegral n
38−-- NLe n -> i <= fromIntegral n
39−-- NGt n -> i > fromIntegral n
40−-- Disproved _ -> mzero
41−-- J.Array v -> case s %~ SJArray of
42−-- Proved Refl -> case fromSing c of
43−-- AEq n -> pure . (== fromIntegral n) . F.length $ v
44−-- Disproved _ -> Nothing
45−-- J.Null -> Just True
48−-- validateConstraints
54−-- validateConstraints s cs v = and <$> traverse alg cs
56−-- alg c = validateConstraint s c v
59−-- :: (SDecide JType, TopLevel spec)
63−-- validateJson = validateBySchema . fromSing
70−-- validateBySchema s v = case (unfix s, v) of
71−-- (SchemaArray cs ss, jv@(J.Array v)) -> do
72−-- itself <- validateConstraints SJArray cs jv
73−-- content <- traverse (validateBySchema ss) v
74−-- pure $ itself && and content
75−-- (SchemaObject ocs, J.Object o) -> do
76−-- fmap and $ for ocs $ \(fieldName, s) -> do
77−-- val <- H.lookup (T.pack fieldName) o
78−-- validateBySchema s val
79−-- (SchemaText cs, js@(J.String _)) -> validateConstraints SJText cs js
80−-- (SchemaNumber cs, jn@(J.Number _)) -> validateConstraints SJNumber cs jn
81−-- (SchemaNull, J.Null) -> Just True