diff --git a/bench/bench.hs b/bench/bench.hs index 1946b3e..daf6302 100644 --- a/bench/bench.hs +++ b/bench/bench.hs @@ -105,6 +105,12 @@ prepareBools = fmap (fmap T.encodeUtf8) . generate' (Deterministic 555) (GenSize prepareNonBools :: IO [ByteString] prepareNonBools = fmap (fmap T.encodeUtf8) . generate' (Deterministic 666) (GenSize 100) $ vectorOf 100 renderedNonBool +prepareDates :: IO [ByteString] +prepareDates = generate' (Deterministic 555) (GenSize 100) $ vectorOf 100 renderedDate + +prepareNonDates :: IO [ByteString] +prepareNonDates = generate' (Deterministic 666) (GenSize 100) $ vectorOf 100 renderedNonDate + benchABDecode :: FileFormat -> NonEmpty ViewFile -> IO () benchABDecode ff vfs = let sep = Separator . fromIntegral $ ord '|' @@ -150,6 +156,9 @@ benchToRow = toRow . Right benchCheckFieldBool :: [ByteString] -> [Bool] benchCheckFieldBool = fmap checkFieldBool +benchCheckFieldDate :: [ByteString] -> [Bool] +benchCheckFieldDate = fmap checkFieldDate + main :: IO () main = do withTempDirectory "." "warden-bench-" $ \root -> @@ -160,11 +169,17 @@ main = do , bench "decode/delimited-text/1000" $ nfIO (benchABDecode DelimitedText vfs) , bench "decode/toRow/100" $ nf benchToRow bss ] - , env ((,,) <$> prepareRow <*> prepareBools <*> prepareNonBools) $ \ ~(rs, bools, nonbools) -> + , env ((,,,,) <$> prepareRow + <*> prepareBools + <*> prepareNonBools + <*> prepareDates + <*> prepareNonDates) $ \ ~(rs, bools, nonbools, dates, nondates) -> bgroup "field-parsing" $ [ bench "parseField/200" $ nf benchFieldParse rs , bench "checkFieldBool/boolean/100" $ nf benchCheckFieldBool bools , bench "checkFieldBool/non-boolean/100" $ nf benchCheckFieldBool nonbools + , bench "checkFieldDate/date/100" $ nf benchCheckFieldDate dates + , bench "checkFieldDate/non-date/100" $ nf benchCheckFieldDate nondates ] , env prepareFolds $ \ ~(rs, ts, piis, nonPiis, bs100, bs10) -> bgroup "folds" $ [ diff --git a/cbits/field.c b/cbits/field.c index a7aedfe..b98a5b1 100644 --- a/cbits/field.c +++ b/cbits/field.c @@ -127,7 +127,7 @@ static inline bool is_separator(char c) { precondition: n >= 8 */ static inline bool match_ymd(char *buf, size_t n) { - /* 0xc0 = 0x80 & 0x40 - if these bits are set, the byte is too + /* 0xc0 = 0x80 | 0x40 - if these bits are set, the byte is too high to be a digit or a separator. */ static const int64_t ymd_mask = 0xc0c0c0c0c0c0ffff; @@ -138,7 +138,7 @@ static inline bool match_ymd(char *buf, size_t n) { /* First, we drop everything which doesn't start with '20' and have eight bytes compatible with a YYYYxMMxDD format. */ - if (!((*p & ymd_mask) == ymd_bits) && is_digit(buf[2]) && is_digit(buf[3])) { + if (!(((*p & ymd_mask) == ymd_bits) && is_digit(buf[2]) && is_digit(buf[3]))) { return FALSE; } diff --git a/test/Test/Warden/Arbitrary.hs b/test/Test/Warden/Arbitrary.hs index a4f9aea..3e93e13 100644 --- a/test/Test/Warden/Arbitrary.hs +++ b/test/Test/Warden/Arbitrary.hs @@ -799,12 +799,13 @@ instance Arbitrary PIICheckType where genSensibleDateTime :: Gen UTCTime genSensibleDateTime = do + -- sometime this century days <- ModifiedJulianDay <$> choose (142 * 365, 192 * 365) secs <- secondsToDiffTime <$> choose (0, 86401) pure $ UTCTime days secs -genDateTimeField :: Gen BS.ByteString -genDateTimeField = do +renderedDate :: Gen BS.ByteString +renderedDate = do dt <- genSensibleDateTime render <- frequency [(1, renderNoSeparator), (9, renderSeparator)] pure . BSC.pack $ render dt @@ -828,10 +829,10 @@ genDateTimeField = do ] -genNonDateTimeField :: Gen BS.ByteString -genNonDateTimeField = do +renderedNonDate :: Gen BS.ByteString +renderedNonDate = do x <- fmap BS.pack $ listOf1 arbitrary - dt <- genDateTimeField + dt <- renderedDate oneof [ pure $ x <> dt , pure $ BS.reverse dt diff --git a/test/Test/Warden/Parser/Field.hs b/test/Test/Warden/Parser/Field.hs index 85e5a9a..909dc04 100644 --- a/test/Test/Warden/Parser/Field.hs +++ b/test/Test/Warden/Parser/Field.hs @@ -78,13 +78,13 @@ prop_numericFieldP_neg = forAll (elements muppets) $ \t -> let r = parseOnly numericFieldP $ T.encodeUtf8 t in isLeft r === True -prop_dateFieldP_pos :: Property -prop_dateFieldP_pos = forAll genDateTimeField $ \bs -> +prop_checkFieldDate_pos :: Property +prop_checkFieldDate_pos = forAll renderedDate $ \bs -> let r = checkFieldDate bs in r === True -prop_dateFieldP_neg :: Property -prop_dateFieldP_neg = forAll genNonDateTimeField $ \bs -> +prop_checkFieldDate_neg :: Property +prop_checkFieldDate_neg = forAll renderedNonDate $ \bs -> let r = checkFieldDate bs in r === False