Benchmarks for checkFieldDate

haskell-mafia · Jul 19, 2016 · 00fd1c0 · 00fd1c0
1 parent aa1d193
commit 00fd1c0
Show file tree

Hide file tree

Showing 4 changed files with 28 additions and 12 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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