git.iko.soy/schematic
on master help sign in
attempt to rebuild iso8601 validation
fced3b9Denis Redozubov
src/Data/Schematic/Helpers.hs+46−3
compare with master
unifiedsplit
@@ -1,13 +1,56 @@
1module Data.Schematic.Helpers where
1module Data.Schematic.Helpers where
2
2
3import Data.Schematic.Schema
3import Data.Schematic.Schema
4+import GHC.TypeLits
5+
4
6
5type UUIDRegex =
7type UUIDRegex =
6 'TRegex "[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}"
8 'TRegex "[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}"
7
9
8type IsUUID = '[UUIDRegex]
10type IsUUID = '[UUIDRegex]
9
11
10−type ISO8601Regex =
12+-- [ "1985-04-12T23:20:50.52Z"
11− 'TRegex "(\\d{4}-[01]\\d-[0-3]\\dT[0-2]\\d:[0-5]\\d:[0-5]\\d\\.\\d+([+-][0-2]\\d:[0-5]\\d|Z))|(\\d{4}-[01]\\d-[0-3]\\dT[0-2]\\d:[0-5]\\d:[0-5]\\d([+-][0-2]\\d:[0-5]\\d|Z))|(\\d{4}-[01]\\d-[0-3]\\dT[0-2]\\d:[0-5]\\d([+-][0-2]\\d:[0-5]\\d|Z))"
13+-- , "1996-12-19T16:39:57-08:00"
14+-- , "1990-12-31T23:59:60Z"
15+-- , "1990-12-31T15:59:60-08:00"
16+-- , "1937-01-01T12:00:27.87+00:20"
17+-- ]
18+
19+-- components
20+type ISO8601Date = "[1-9][0-9]{3}-(0[1-9]|1[0-2])-[0-3][0-9]"
21+
22+type ISO8601Time = "(?:[0-2][0-9]:[0-2][0-9]:[0-6][0-9])?"
23+
24+type ISO8601DateTime = AppendSymbol ISO8601Date (AppendSymbol "T" ISO8601Time)
25+
26+type ISO8601UTC = "(Z|\\+00:00)"
27+
28+type ISO8601DateTimeUTC =
29+ AppendSymbol ISO8601Date (AppendSymbol "T" (AppendSymbol ISO8601Time ISO8601UTC))
30+
31+type ISO8601TZ = "\\+[0-1][0-9]:[0-6][0-9]"
32+
33+type ISO8601DateTimeZoned =
34+ AppendSymbol ISO8601Date (AppendSymbol "T" (AppendSymbol ISO8601Time ISO8601TZ))
35+
36+-- regexes
37+type ISO8601DateRegex = 'TRegex ISO8601Date
38+
39+type ISO8601TimeRegex = 'TRegex ISO8601Time
40+
41+type ISO8601DateTimeRegex = 'TRegex ISO8601DateTime
42+
43+type ISO8601DateTimeRegexUTC = 'TRegex ISO8601DateTimeUTC
44+
45+type ISO8601DateTimeRegexZoned = 'TRegex ISO8601DateTimeZoned
46+
47+-- constraints
48+type IsDate = '[ISO8601DateRegex]
49+
50+type IsTime = '[ISO8601TimeRegex]
51+
52+type IsDateTime = '[ISO8601DateTimeRegex]
53+
54+type IsZonedDateTime = '[ISO8601DateTimeRegexZoned]
12
55
13−type IsDateTime = '[ISO8601Regex]
56+type IsUTCDateTime = '[ISO8601DateTimeRegexUTC]
test/HelpersSpec.hs+39−2
@@ -24,11 +24,20 @@ type UUIDSchema = 'SchemaObject '[ '("uuid", 'SchemaText IsUUID) ]
24uuid :: Text
24uuid :: Text
25uuid = "f81d4fae-7dec-11d0-a765-00a0c91e6bf6"
25uuid = "f81d4fae-7dec-11d0-a765-00a0c91e6bf6"
26
26
27+type ISO8601DateSchema = 'SchemaObject '[ '("date", 'SchemaText IsDate) ]
28+
29+iso8601dates :: [Text]
30+iso8601dates = [ "1985-04-12" ]
31+
32+invalidIso8601dates :: [Text]
33+invalidIso8601dates = [ "1999-13-12" ]
34+
27−type ISO8601Schema = 'SchemaObject '[ '("datetime", 'SchemaText IsDateTime) ]
35+type ISO8601DateTimeSchema = 'SchemaObject '[ '("datetime", 'SchemaText IsDateTime) ]
28
36
29-- | Taken from ISO8601 RFC 3339
37-- | Taken from ISO8601 RFC 3339
30iso8601datetimes :: [Text]
38iso8601datetimes :: [Text]
31iso8601datetimes =
39iso8601datetimes =
40+ iso8601dates <>
32 [ "1985-04-12T23:20:50.52Z"
41 [ "1985-04-12T23:20:50.52Z"
33 , "1996-12-19T16:39:57-08:00"
42 , "1996-12-19T16:39:57-08:00"
34 , "1990-12-31T23:59:60Z"
43 , "1990-12-31T23:59:60Z"
@@ -36,6 +45,15 @@ iso8601datetimes =
36 , "1937-01-01T12:00:27.87+00:20"
45 , "1937-01-01T12:00:27.87+00:20"
37 ]
46 ]
38
47
48+invalidIso8601datetimes :: [Text]
49+invalidIso8601datetimes =
50+ [ "1985-04-29T23:20:50.52Z"
51+ , "1996-12-129T16:39:57-08:00"
52+ , "1990-2-31T23:59:60Z"
53+ , "1990-12-31T15:59:70"
54+ , "1937-01-01T12:00:27.87+24:20"
55+ ]
56+
39spec :: Spec
57spec :: Spec
40spec = do
58spec = do
41 describe "UUID: " $ do
59 describe "UUID: " $ do
@@ -51,11 +69,30 @@ spec = do
51 (decodeAndValidateJson incorrectJson :: ParseResult (JsonRepr UUIDSchema))
69 (decodeAndValidateJson incorrectJson :: ParseResult (JsonRepr UUIDSchema))
52 `shouldSatisfy` isValidationError
70 `shouldSatisfy` isValidationError
53
71
72+ describe "ISO8601 date: " $ do
73+ for_ iso8601dates $ \dt -> do
74+ it ("validates correct date - " <> dt ^. unpacked) $ do
75+ let json = "{\"date\": \"" <> (dt ^. unpacked . packedChars) <> "\" }"
76+ (decodeAndValidateJson json :: ParseResult (JsonRepr ISO8601DateSchema))
77+ `shouldSatisfy` isValid
78+
79+ for_ invalidIso8601dates $ \dt -> do
80+ it ("fails to validate incorrect date - " <> dt ^. unpacked) $ do
81+ let json = "{\"date\": \"" <> (dt ^. unpacked . packedChars) <> "\" }"
82+ (decodeAndValidateJson json :: ParseResult (JsonRepr ISO8601DateSchema))
83+ `shouldSatisfy` isValidationError
84+
54 describe "ISO8601 datetime: " $ do
85 describe "ISO8601 datetime: " $ do
55 for_ iso8601datetimes $ \dt -> do
86 for_ iso8601datetimes $ \dt -> do
56 it ("validates correct datetime - " <> dt ^. unpacked) $ do
87 it ("validates correct datetime - " <> dt ^. unpacked) $ do
57 let json = "{\"datetime\": \"" <> (dt ^. unpacked . packedChars) <> "\" }"
88 let json = "{\"datetime\": \"" <> (dt ^. unpacked . packedChars) <> "\" }"
58− (decodeAndValidateJson json :: ParseResult (JsonRepr ISO8601Schema))
89+ (decodeAndValidateJson json :: ParseResult (JsonRepr ISO8601DateTimeSchema))
90+ `shouldSatisfy` isValid
91+
92+ for_ invalidIso8601datetimes $ \dt -> do
93+ it ("fails to validate incorrect datetime - " <> dt ^. unpacked) $ do
94+ let json = "{\"datetime\": \"" <> (dt ^. unpacked . packedChars) <> "\" }"
95+ (decodeAndValidateJson json :: ParseResult (JsonRepr ISO8601DateTimeSchema))
59 `shouldSatisfy` isValidationError
96 `shouldSatisfy` isValidationError
60
97
61main :: IO ()
98main :: IO ()