Skip to content

Commit 5dbdde3

Browse files
AnisimoffNikitaAnisimoffNikita
committed
fix: codestyle
1 parent 6cc400e commit 5dbdde3

File tree

5 files changed

+67
-52
lines changed

5 files changed

+67
-52
lines changed

‎src/Data/Schematic/Validation.hs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -64,28 +64,28 @@ validateTextConstraint (JSONPath path) t = \case
6464
STLt n -> do
6565
let
6666
nlen = withKnownNat n $ natVal n
67-
predicate = nlen < (fromIntegral $ T.length t)
67+
predicate = nlen > (fromIntegral $ T.length t)
6868
errMsg = "length of " <> path <> " should be < " <> T.pack (show nlen)
6969
warn = vWarning $ mmSingleton path (pure errMsg)
7070
unless predicate warn
7171
STLe n -> do
7272
let
7373
nlen = withKnownNat n $ natVal n
74-
predicate = nlen <= (fromIntegral $ T.length t)
74+
predicate = nlen >= (fromIntegral $ T.length t)
7575
errMsg = "length of " <> path <> " should be <= " <> T.pack (show nlen)
7676
warn = vWarning $ mmSingleton path (pure errMsg)
7777
unless predicate warn
7878
STGt n -> do
7979
let
8080
nlen = withKnownNat n $ natVal n
81-
predicate = nlen > (fromIntegral $ T.length t)
81+
predicate = nlen < (fromIntegral $ T.length t)
8282
errMsg = "length of " <> path <> " should be > " <> T.pack (show nlen)
8383
warn = vWarning $ mmSingleton path (pure errMsg)
8484
unless predicate warn
8585
STGe n -> do
8686
let
8787
nlen = withKnownNat n $ natVal n
88-
predicate = nlen >= (fromIntegral $ T.length t)
88+
predicate = nlen <= (fromIntegral $ T.length t)
8989
errMsg = "length of " <> path <> " should be >= " <> T.pack (show nlen)
9090
warn = vWarning $ mmSingleton path (pure errMsg)
9191
unless predicate warn

‎src/Data/Schematic/Verifier/Common.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@ simplifyNumberConstraint :: ([Integer] -> Integer) -> [Integer] -> Maybe Integer
66
simplifyNumberConstraint f =
77
\case
88
[] -> Nothing
9-
x -> Just $ f x
9+
x -> Just $ f x
1010

1111
simplifyDNLs :: [Integer] -> Maybe Integer
1212
simplifyDNLs = simplifyNumberConstraint minimum
@@ -17,8 +17,8 @@ simplifyDNGs = simplifyNumberConstraint maximum
1717
verifyDNEq :: [Integer] -> Maybe (Maybe Integer)
1818
verifyDNEq x =
1919
case nub x of
20-
[] -> Just Nothing
21-
[y] -> Just $ Just y
20+
[] -> Just Nothing
21+
[y] -> Just $ Just y
2222
(_:_:_) -> Nothing
2323

2424
verify3 :: Maybe Integer -> Maybe Integer -> Maybe Integer -> Maybe ()

‎src/Data/Schematic/Verifier/Number.hs‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -20,9 +20,10 @@ verifyNumberConstraints ::
2020
[DemotedNumberConstraint]
2121
-> Maybe VerifiedNumberConstraint
2222
verifyNumberConstraints cs' = do
23-
let cs = toStrictNumber cs'
24-
mlt = simplifyDNLs [x | DNLt x <- cs]
25-
mgt = simplifyDNGs [x | DNGt x <- cs]
23+
let
24+
cs = toStrictNumber cs'
25+
mlt = simplifyDNLs [x | DNLt x <- cs]
26+
mgt = simplifyDNGs [x | DNGt x <- cs]
2627
meq <- verifyDNEq [x | DNEq x <- cs]
2728
verifyEquations mgt meq mlt
2829
Just $

‎src/Data/Schematic/Verifier/Text.hs‎

Lines changed: 46 additions & 42 deletions
Original file line numberDiff line numberDiff line change
@@ -25,8 +25,9 @@ data VerifiedTextConstraint
2525
| VTEnum [Text]
2626
deriving (Show)
2727

28-
verifyTextLengthConstraints ::
29-
[DemotedTextConstraint] -> Maybe (Maybe VerifiedTextConstraint)
28+
verifyTextLengthConstraints
29+
:: [DemotedTextConstraint]
30+
-> Maybe (Maybe VerifiedTextConstraint)
3031
verifyTextLengthConstraints cs' = do
3132
let cs = toStrictTextLength cs'
3233
mlt = simplifyDNLs [x | DTLt x <- cs]
@@ -35,7 +36,7 @@ verifyTextLengthConstraints cs' = do
3536
verifyEquations mgt meq mlt
3637
case all isNothing ([mgt, meq, mlt] :: [Maybe Integer]) of
3738
True -> Just Nothing
38-
_ ->
39+
_ ->
3940
Just $
4041
Just $
4142
case meq of
@@ -46,73 +47,76 @@ regexLength :: Text -> Maybe (Int, Maybe Int)
4647
regexLength regexp =
4748
case parseRegex . unpack $ regexp of
4849
Right (p, _) -> Just (minRegexLength p, maxRegexLength p)
49-
Left _ -> Nothing
50+
Left _ -> Nothing
5051

5152
minRegexLength :: Pattern -> Int
5253
minRegexLength p =
5354
case p of
54-
PEmpty -> 0
55-
PChar {..} -> 1
56-
PAny {..} -> 1
57-
PAnyNot {..} -> 1
58-
PQuest _ -> 0
59-
PPlus sch -> minRegexLength $ PBound 1 Nothing sch
60-
PStar _ sch -> minRegexLength $ PBound 0 Nothing sch
55+
PEmpty -> 0
56+
PChar {..} -> 1
57+
PAny {..} -> 1
58+
PAnyNot {..} -> 1
59+
PQuest _ -> 0
60+
PPlus sch -> minRegexLength $ PBound 1 Nothing sch
61+
PStar _ sch -> minRegexLength $ PBound 0 Nothing sch
6162
PBound low _ sch -> low * minRegexLength sch
62-
PConcat ps -> sum $ fmap minRegexLength ps
63-
POr xs -> minimum $ fmap minRegexLength xs
64-
PDot _ -> 1
65-
PEscape {..} -> 1
66-
PCarat _ -> 0
67-
PDollar _ -> 0
68-
_ -> 0
63+
PConcat ps -> sum $ fmap minRegexLength ps
64+
POr xs -> minimum $ fmap minRegexLength xs
65+
PDot _ -> 1
66+
PEscape {..} -> 1
67+
PCarat _ -> 0
68+
PDollar _ -> 0
69+
_ -> 0
6970

7071
maxRegexLength :: Pattern -> Maybe Int
7172
maxRegexLength p =
7273
case p of
73-
PEmpty -> Just 0
74-
PChar _ _ -> Just 1
75-
PAny _ _ -> Just 1
76-
PAnyNot _ _ -> Just 1
77-
PQuest _ -> Just 0
78-
PPlus _ -> Nothing
79-
PStar _ _ -> Nothing
74+
PEmpty -> Just 0
75+
PChar _ _ -> Just 1
76+
PAny _ _ -> Just 1
77+
PAnyNot _ _ -> Just 1
78+
PQuest _ -> Just 0
79+
PPlus _ -> Nothing
80+
PStar _ _ -> Nothing
8081
PBound _ mhigh sch -> (*) <$> mhigh <*> maxRegexLength sch
81-
PConcat ps -> sum <$> mapM maxRegexLength ps
82-
POr xs -> maximum <$> mapM maxRegexLength xs
83-
PDot _ -> Just 1
84-
PEscape _ _ -> Just 1
85-
PCarat _ -> Just 0
86-
PDollar _ -> Just 0
87-
_ -> Just 0
82+
PConcat ps -> sum <$> mapM maxRegexLength ps
83+
POr xs -> maximum <$> mapM maxRegexLength xs
84+
PDot _ -> Just 1
85+
PEscape _ _ -> Just 1
86+
PCarat _ -> Just 0
87+
PDollar _ -> Just 0
88+
_ -> Just 0
8889

89-
verifyTextRegexConstraint ::
90-
[DemotedTextConstraint] -> Maybe (Maybe VerifiedTextConstraint)
90+
verifyTextRegexConstraint
91+
:: [DemotedTextConstraint]
92+
-> Maybe (Maybe VerifiedTextConstraint)
9193
verifyTextRegexConstraint cs = do
9294
let regexps = [x | DTRegex x <- cs]
9395
case regexps of
94-
[] -> Just Nothing
96+
[] -> Just Nothing
9597
[x] -> do
9698
(l, mh) <- regexLength x
9799
Just $ Just $ VTRegex x (fromIntegral l) (fromIntegral <$> mh)
98-
_ -> Nothing
100+
_ -> Nothing
99101

100-
verifyTextEnumConstraint ::
101-
[DemotedTextConstraint] -> Maybe (Maybe VerifiedTextConstraint)
102+
verifyTextEnumConstraint
103+
:: [DemotedTextConstraint]
104+
-> Maybe (Maybe VerifiedTextConstraint)
102105
verifyTextEnumConstraint cs = do
103106
let enums = concat [x | DTEnum x <- cs]
104107
case enums of
105108
[] -> Just Nothing
106-
x -> Just $ Just $ VTEnum x
109+
x -> Just $ Just $ VTEnum x
107110

108-
verifyTextConstraints ::
109-
[DemotedTextConstraint] -> Maybe [VerifiedTextConstraint]
111+
verifyTextConstraints
112+
:: [DemotedTextConstraint]
113+
-> Maybe [VerifiedTextConstraint]
110114
verifyTextConstraints cs = do
111115
regexp <- verifyTextRegexConstraint cs
112116
void $ case regexp of
113117
Just (VTRegex _ l mh) ->
114118
verifyTextLengthConstraints (DTGe l : cs ++ maybeToList (DTLe <$> mh))
115-
_ -> pure Nothing
119+
_ -> pure Nothing
116120
lengths <- verifyTextLengthConstraints cs
117121
enums <- verifyTextEnumConstraint cs
118122
return $ catMaybes [lengths, enums, regexp]

‎test/SchemaSpec.hs‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -33,6 +33,10 @@ type SchemaExample = 'SchemaObject
3333
'[ '("foo", 'SchemaArray '[ 'AEq 1] ('SchemaNumber '[ 'NGt 10]))
3434
, '("bar", 'SchemaOptional ('SchemaText '[ 'TEnum '["foo", "bar"]]))]
3535

36+
type SchemaExample2 = 'SchemaObject
37+
'[ '("foo", 'SchemaArray '[ 'AEq 2] ('SchemaText '[ 'TGt 10]))
38+
, '("bar", 'SchemaOptional ('SchemaText '[ 'TRegex "[0-9]+"]))]
39+
3640
jsonExample :: JsonRepr SchemaExample
3741
jsonExample = withRepr @SchemaExample
3842
$ field @"bar" (Just "bar")
@@ -79,6 +83,9 @@ schemaJson2 = "{\"foo\": [3], \"bar\": null}"
7983
schemaJsonSeries :: Monad m => SC.Series m (JsonRepr SchemaExample)
8084
schemaJsonSeries = series
8185

86+
schemaJsonSeries2 :: Monad m => SC.Series m (JsonRepr SchemaExample2)
87+
schemaJsonSeries2 = series
88+
8289
spec :: Spec
8390
spec = do
8491
-- it "show/read JsonRepr properly" $
@@ -106,6 +113,9 @@ spec = do
106113
it "validates json series" $ property $
107114
SC.over schemaJsonSeries $ \x ->
108115
isValid (parseAndValidateJson @SchemaExample (toJSON x))
116+
it "validates json series 2" $ property $
117+
SC.over schemaJsonSeries2 $ \x ->
118+
isValid (parseAndValidateJson @SchemaExample2 (toJSON x))
109119

110120

111121
main :: IO ()

0 commit comments

Comments
 (0)