git.iko.soy/typeable/schematic
on master help sign in
attempt to rebuild iso8601 validation
commitfced3b905eddae2514318a77105640fadb79093d authorDenis Redozubov <denis.redozubov@gmail.com> dateFri 29 Sep 2017, 17:06 (9 years ago) parent870bf5d
2 files changed+85−5
compare with master
unifiedsplit
src/Data/Schematic/Helpers.hs+46−3 test/HelpersSpec.hs+39−2
src/Data/Schematic/Helpers.hs+46−3
@@ -1,13 +1,56 @@
11module Data.Schematic.Helpers where
22
33import Data.Schematic.Schema
4+import GHC.TypeLits
5+
46
57type UUIDRegex =
68 'TRegex "[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}"
79
810type IsUUID = '[UUIDRegex]
911
10−type ISO8601Regex =
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))"
12+-- [ "1985-04-12T23:20:50.52Z"
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]
1255
13−type IsDateTime = '[ISO8601Regex]
56+type IsUTCDateTime = '[ISO8601DateTimeRegexUTC]
test/HelpersSpec.hs+39−2
@@ -24,11 +24,20 @@ type UUIDSchema = 'SchemaObject '[ '("uuid", 'SchemaText IsUUID) ]
2424uuid :: Text
2525uuid = "f81d4fae-7dec-11d0-a765-00a0c91e6bf6"
2626
27−type ISO8601Schema = 'SchemaObject '[ '("datetime", 'SchemaText IsDateTime) ]
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+
35+type ISO8601DateTimeSchema = 'SchemaObject '[ '("datetime", 'SchemaText IsDateTime) ]
2836
2937-- | Taken from ISO8601 RFC 3339
3038iso8601datetimes :: [Text]
3139iso8601datetimes =
40+ iso8601dates <>
3241 [ "1985-04-12T23:20:50.52Z"
3342 , "1996-12-19T16:39:57-08:00"
3443 , "1990-12-31T23:59:60Z"
@@ -36,6 +45,15 @@ iso8601datetimes =
3645 , "1937-01-01T12:00:27.87+00:20"
3746 ]
3847
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+
3957spec :: Spec
4058spec = do
4159 describe "UUID: " $ do
@@ -51,11 +69,30 @@ spec = do
5169 (decodeAndValidateJson incorrectJson :: ParseResult (JsonRepr UUIDSchema))
5270 `shouldSatisfy` isValidationError
5371
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+
5485 describe "ISO8601 datetime: " $ do
5586 for_ iso8601datetimes $ \dt -> do
5687 it ("validates correct datetime - " <> dt ^. unpacked) $ do
5788 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))
5996 `shouldSatisfy` isValidationError
6097
6198main :: IO ()