git.iko.soy/schematic
on master help sign in
fix: codestyle
5dbdde3Nikita
src/Data/Schematic/Validation.hs+4−4
compare with master
unifiedsplit
@@ -64,28 +64,28 @@ validateTextConstraint (JSONPath path) t = \case
64 STLt n -> do
64 STLt n -> do
65 let
65 let
66 nlen = withKnownNat n $ natVal n
66 nlen = withKnownNat n $ natVal n
67− predicate = nlen < (fromIntegral $ T.length t)
67+ predicate = nlen > (fromIntegral $ T.length t)
68 errMsg = "length of " <> path <> " should be < " <> T.pack (show nlen)
68 errMsg = "length of " <> path <> " should be < " <> T.pack (show nlen)
69 warn = vWarning $ mmSingleton path (pure errMsg)
69 warn = vWarning $ mmSingleton path (pure errMsg)
70 unless predicate warn
70 unless predicate warn
71 STLe n -> do
71 STLe n -> do
72 let
72 let
73 nlen = withKnownNat n $ natVal n
73 nlen = withKnownNat n $ natVal n
74− predicate = nlen <= (fromIntegral $ T.length t)
74+ predicate = nlen >= (fromIntegral $ T.length t)
75 errMsg = "length of " <> path <> " should be <= " <> T.pack (show nlen)
75 errMsg = "length of " <> path <> " should be <= " <> T.pack (show nlen)
76 warn = vWarning $ mmSingleton path (pure errMsg)
76 warn = vWarning $ mmSingleton path (pure errMsg)
77 unless predicate warn
77 unless predicate warn
78 STGt n -> do
78 STGt n -> do
79 let
79 let
80 nlen = withKnownNat n $ natVal n
80 nlen = withKnownNat n $ natVal n
81− predicate = nlen > (fromIntegral $ T.length t)
81+ predicate = nlen < (fromIntegral $ T.length t)
82 errMsg = "length of " <> path <> " should be > " <> T.pack (show nlen)
82 errMsg = "length of " <> path <> " should be > " <> T.pack (show nlen)
83 warn = vWarning $ mmSingleton path (pure errMsg)
83 warn = vWarning $ mmSingleton path (pure errMsg)
84 unless predicate warn
84 unless predicate warn
85 STGe n -> do
85 STGe n -> do
86 let
86 let
87 nlen = withKnownNat n $ natVal n
87 nlen = withKnownNat n $ natVal n
88− predicate = nlen >= (fromIntegral $ T.length t)
88+ predicate = nlen <= (fromIntegral $ T.length t)
89 errMsg = "length of " <> path <> " should be >= " <> T.pack (show nlen)
89 errMsg = "length of " <> path <> " should be >= " <> T.pack (show nlen)
90 warn = vWarning $ mmSingleton path (pure errMsg)
90 warn = vWarning $ mmSingleton path (pure errMsg)
91 unless predicate warn
91 unless predicate warn
src/Data/Schematic/Verifier/Common.hs+3−3
@@ -6,7 +6,7 @@ simplifyNumberConstraint :: ([Integer] -> Integer) -> [Integer] -> Maybe Integer
6simplifyNumberConstraint f =
6simplifyNumberConstraint f =
7 \case
7 \case
8 [] -> Nothing
8 [] -> Nothing
9− x -> Just $ f x
9+ x -> Just $ f x
10
10
11simplifyDNLs :: [Integer] -> Maybe Integer
11simplifyDNLs :: [Integer] -> Maybe Integer
12simplifyDNLs = simplifyNumberConstraint minimum
12simplifyDNLs = simplifyNumberConstraint minimum
@@ -17,8 +17,8 @@ simplifyDNGs = simplifyNumberConstraint maximum
17verifyDNEq :: [Integer] -> Maybe (Maybe Integer)
17verifyDNEq :: [Integer] -> Maybe (Maybe Integer)
18verifyDNEq x =
18verifyDNEq x =
19 case nub x of
19 case nub x of
20− [] -> Just Nothing
20+ [] -> Just Nothing
21− [y] -> Just $ Just y
21+ [y] -> Just $ Just y
22 (_:_:_) -> Nothing
22 (_:_:_) -> Nothing
23
23
24verify3 :: Maybe Integer -> Maybe Integer -> Maybe Integer -> Maybe ()
24verify3 :: Maybe Integer -> Maybe Integer -> Maybe Integer -> Maybe ()
src/Data/Schematic/Verifier/Number.hs+4−3
@@ -20,9 +20,10 @@ verifyNumberConstraints ::
20 [DemotedNumberConstraint]
20 [DemotedNumberConstraint]
21 -> Maybe VerifiedNumberConstraint
21 -> Maybe VerifiedNumberConstraint
22verifyNumberConstraints cs' = do
22verifyNumberConstraints cs' = do
23+ let
23− let cs = toStrictNumber cs'
24+ cs = toStrictNumber cs'
24− mlt = simplifyDNLs [x | DNLt x <- cs]
25+ mlt = simplifyDNLs [x | DNLt x <- cs]
25− mgt = simplifyDNGs [x | DNGt x <- cs]
26+ mgt = simplifyDNGs [x | DNGt x <- cs]
26 meq <- verifyDNEq [x | DNEq x <- cs]
27 meq <- verifyDNEq [x | DNEq x <- cs]
27 verifyEquations mgt meq mlt
28 verifyEquations mgt meq mlt
28 Just $
29 Just $
src/Data/Schematic/Verifier/Text.hs+46−42
@@ -25,8 +25,9 @@ data VerifiedTextConstraint
25 | VTEnum [Text]
25 | VTEnum [Text]
26 deriving (Show)
26 deriving (Show)
27
27
28−verifyTextLengthConstraints ::
28+verifyTextLengthConstraints
29+ :: [DemotedTextConstraint]
29− [DemotedTextConstraint] -> Maybe (Maybe VerifiedTextConstraint)
30+ -> Maybe (Maybe VerifiedTextConstraint)
30verifyTextLengthConstraints cs' = do
31verifyTextLengthConstraints cs' = do
31 let cs = toStrictTextLength cs'
32 let cs = toStrictTextLength cs'
32 mlt = simplifyDNLs [x | DTLt x <- cs]
33 mlt = simplifyDNLs [x | DTLt x <- cs]
@@ -35,7 +36,7 @@ verifyTextLengthConstraints cs' = do
35 verifyEquations mgt meq mlt
36 verifyEquations mgt meq mlt
36 case all isNothing ([mgt, meq, mlt] :: [Maybe Integer]) of
37 case all isNothing ([mgt, meq, mlt] :: [Maybe Integer]) of
37 True -> Just Nothing
38 True -> Just Nothing
38− _ ->
39+ _ ->
39 Just $
40 Just $
40 Just $
41 Just $
41 case meq of
42 case meq of
@@ -46,73 +47,76 @@ regexLength :: Text -> Maybe (Int, Maybe Int)
46regexLength regexp =
47regexLength regexp =
47 case parseRegex . unpack $ regexp of
48 case parseRegex . unpack $ regexp of
48 Right (p, _) -> Just (minRegexLength p, maxRegexLength p)
49 Right (p, _) -> Just (minRegexLength p, maxRegexLength p)
49− Left _ -> Nothing
50+ Left _ -> Nothing
50
51
51minRegexLength :: Pattern -> Int
52minRegexLength :: Pattern -> Int
52minRegexLength p =
53minRegexLength p =
53 case p of
54 case p of
54− PEmpty -> 0
55+ PEmpty -> 0
55− PChar {..} -> 1
56+ PChar {..} -> 1
56− PAny {..} -> 1
57+ PAny {..} -> 1
57− PAnyNot {..} -> 1
58+ PAnyNot {..} -> 1
58− PQuest _ -> 0
59+ PQuest _ -> 0
59− PPlus sch -> minRegexLength $ PBound 1 Nothing sch
60+ PPlus sch -> minRegexLength $ PBound 1 Nothing sch
60− PStar _ sch -> minRegexLength $ PBound 0 Nothing sch
61+ PStar _ sch -> minRegexLength $ PBound 0 Nothing sch
61 PBound low _ sch -> low * minRegexLength sch
62 PBound low _ sch -> low * minRegexLength sch
62− PConcat ps -> sum $ fmap minRegexLength ps
63+ PConcat ps -> sum $ fmap minRegexLength ps
63− POr xs -> minimum $ fmap minRegexLength xs
64+ POr xs -> minimum $ fmap minRegexLength xs
64− PDot _ -> 1
65+ PDot _ -> 1
65− PEscape {..} -> 1
66+ PEscape {..} -> 1
66− PCarat _ -> 0
67+ PCarat _ -> 0
67− PDollar _ -> 0
68+ PDollar _ -> 0
68− _ -> 0
69+ _ -> 0
69
70
70maxRegexLength :: Pattern -> Maybe Int
71maxRegexLength :: Pattern -> Maybe Int
71maxRegexLength p =
72maxRegexLength p =
72 case p of
73 case p of
73− PEmpty -> Just 0
74+ PEmpty -> Just 0
74− PChar _ _ -> Just 1
75+ PChar _ _ -> Just 1
75− PAny _ _ -> Just 1
76+ PAny _ _ -> Just 1
76− PAnyNot _ _ -> Just 1
77+ PAnyNot _ _ -> Just 1
77− PQuest _ -> Just 0
78+ PQuest _ -> Just 0
78− PPlus _ -> Nothing
79+ PPlus _ -> Nothing
79− PStar _ _ -> Nothing
80+ PStar _ _ -> Nothing
80 PBound _ mhigh sch -> (*) <$> mhigh <*> maxRegexLength sch
81 PBound _ mhigh sch -> (*) <$> mhigh <*> maxRegexLength sch
81− PConcat ps -> sum <$> mapM maxRegexLength ps
82+ PConcat ps -> sum <$> mapM maxRegexLength ps
82− POr xs -> maximum <$> mapM maxRegexLength xs
83+ POr xs -> maximum <$> mapM maxRegexLength xs
83− PDot _ -> Just 1
84+ PDot _ -> Just 1
84− PEscape _ _ -> Just 1
85+ PEscape _ _ -> Just 1
85− PCarat _ -> Just 0
86+ PCarat _ -> Just 0
86− PDollar _ -> Just 0
87+ PDollar _ -> Just 0
87− _ -> Just 0
88+ _ -> Just 0
88
89
89−verifyTextRegexConstraint ::
90+verifyTextRegexConstraint
91+ :: [DemotedTextConstraint]
90− [DemotedTextConstraint] -> Maybe (Maybe VerifiedTextConstraint)
92+ -> Maybe (Maybe VerifiedTextConstraint)
91verifyTextRegexConstraint cs = do
93verifyTextRegexConstraint cs = do
92 let regexps = [x | DTRegex x <- cs]
94 let regexps = [x | DTRegex x <- cs]
93 case regexps of
95 case regexps of
94− [] -> Just Nothing
96+ [] -> Just Nothing
95 [x] -> do
97 [x] -> do
96 (l, mh) <- regexLength x
98 (l, mh) <- regexLength x
97 Just $ Just $ VTRegex x (fromIntegral l) (fromIntegral <$> mh)
99 Just $ Just $ VTRegex x (fromIntegral l) (fromIntegral <$> mh)
98− _ -> Nothing
100+ _ -> Nothing
99
101
100−verifyTextEnumConstraint ::
102+verifyTextEnumConstraint
103+ :: [DemotedTextConstraint]
101− [DemotedTextConstraint] -> Maybe (Maybe VerifiedTextConstraint)
104+ -> Maybe (Maybe VerifiedTextConstraint)
102verifyTextEnumConstraint cs = do
105verifyTextEnumConstraint cs = do
103 let enums = concat [x | DTEnum x <- cs]
106 let enums = concat [x | DTEnum x <- cs]
104 case enums of
107 case enums of
105 [] -> Just Nothing
108 [] -> Just Nothing
106− x -> Just $ Just $ VTEnum x
109+ x -> Just $ Just $ VTEnum x
107
110
108−verifyTextConstraints ::
111+verifyTextConstraints
112+ :: [DemotedTextConstraint]
109− [DemotedTextConstraint] -> Maybe [VerifiedTextConstraint]
113+ -> Maybe [VerifiedTextConstraint]
110verifyTextConstraints cs = do
114verifyTextConstraints cs = do
111 regexp <- verifyTextRegexConstraint cs
115 regexp <- verifyTextRegexConstraint cs
112 void $ case regexp of
116 void $ case regexp of
113 Just (VTRegex _ l mh) ->
117 Just (VTRegex _ l mh) ->
114 verifyTextLengthConstraints (DTGe l : cs ++ maybeToList (DTLe <$> mh))
118 verifyTextLengthConstraints (DTGe l : cs ++ maybeToList (DTLe <$> mh))
115− _ -> pure Nothing
119+ _ -> pure Nothing
116 lengths <- verifyTextLengthConstraints cs
120 lengths <- verifyTextLengthConstraints cs
117 enums <- verifyTextEnumConstraint cs
121 enums <- verifyTextEnumConstraint cs
118 return $ catMaybes [lengths, enums, regexp]
122 return $ catMaybes [lengths, enums, regexp]
test/SchemaSpec.hs+10
@@ -33,6 +33,10 @@ type SchemaExample = 'SchemaObject
33 '[ '("foo", 'SchemaArray '[ 'AEq 1] ('SchemaNumber '[ 'NGt 10]))
33 '[ '("foo", 'SchemaArray '[ 'AEq 1] ('SchemaNumber '[ 'NGt 10]))
34 , '("bar", 'SchemaOptional ('SchemaText '[ 'TEnum '["foo", "bar"]]))]
34 , '("bar", 'SchemaOptional ('SchemaText '[ 'TEnum '["foo", "bar"]]))]
35
35
36+type SchemaExample2 = 'SchemaObject
37+ '[ '("foo", 'SchemaArray '[ 'AEq 2] ('SchemaText '[ 'TGt 10]))
38+ , '("bar", 'SchemaOptional ('SchemaText '[ 'TRegex "[0-9]+"]))]
39+
36jsonExample :: JsonRepr SchemaExample
40jsonExample :: JsonRepr SchemaExample
37jsonExample = withRepr @SchemaExample
41jsonExample = withRepr @SchemaExample
38 $ field @"bar" (Just "bar")
42 $ field @"bar" (Just "bar")
@@ -79,6 +83,9 @@ schemaJson2 = "{\"foo\": [3], \"bar\": null}"
79schemaJsonSeries :: Monad m => SC.Series m (JsonRepr SchemaExample)
83schemaJsonSeries :: Monad m => SC.Series m (JsonRepr SchemaExample)
80schemaJsonSeries = series
84schemaJsonSeries = series
81
85
86+schemaJsonSeries2 :: Monad m => SC.Series m (JsonRepr SchemaExample2)
87+schemaJsonSeries2 = series
88+
82spec :: Spec
89spec :: Spec
83spec = do
90spec = do
84 -- it "show/read JsonRepr properly" $
91 -- it "show/read JsonRepr properly" $
@@ -106,6 +113,9 @@ spec = do
106 it "validates json series" $ property $
113 it "validates json series" $ property $
107 SC.over schemaJsonSeries $ \x ->
114 SC.over schemaJsonSeries $ \x ->
108 isValid (parseAndValidateJson @SchemaExample (toJSON x))
115 isValid (parseAndValidateJson @SchemaExample (toJSON x))
116+ it "validates json series 2" $ property $
117+ SC.over schemaJsonSeries2 $ \x ->
118+ isValid (parseAndValidateJson @SchemaExample2 (toJSON x))
109
119
110
120
111main :: IO ()
121main :: IO ()