diff --git a/bench/Bench.hs b/bench/Bench.hs --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -46,17 +46,22 @@ Thyme.buildTime @Thyme.UTCTime . either error id . parseOnly (Thyme.timeParser Thyme.defaultTimeLocale isoFormatString) - chronosAttoparsec :: BS8.ByteString -> Chronos.Datetime + -- With chronos, we explicitly convert the ymdhms time to the + -- nanoseconds since the epoch. This is done to make the benchmark + -- compare apples to apples. Both thyme and time are computing epoch + -- times, so we want chronos to do the same. + chronosAttoparsec :: BS8.ByteString -> Chronos.Time chronosAttoparsec = - either error id + either error Chronos.datetimeToTime . parseOnly (Chronos.parserUtf8_YmdHMS Chronos.w3c) - chronosZepto :: BS8.ByteString -> Chronos.Datetime + chronosZepto :: BS8.ByteString -> Chronos.Time chronosZepto = - either error id + either error Chronos.datetimeToTime . Z.parse (Chronos.zeptoUtf8_YmdHMS Chronos.w3c) dmy = "%d:%m:%y." hms = "%%H:%M:%S." + dmyhms = isoFormatString timePretty = Time.formatTime Time.defaultTimeLocale thymePretty = Thyme.formatTime Thyme.defaultTimeLocale chronosPrettyDmy = toLazyText @@ -67,6 +72,9 @@ . Chronos.builder_HMS Chronos.SubsecondPrecisionAuto (Just ':') . Chronos.datetimeTime . Chronos.timeToDatetime + chronosPrettyYmdHMS = toLazyText + . Chronos.builder_YmdHMS Chronos.SubsecondPrecisionAuto Chronos.w3c + . Chronos.timeToDatetime timeTime <- Time.getCurrentTime thymeTime <- Thyme.getCurrentTime @@ -95,6 +103,11 @@ , bench "Thyme.formatTime" $ nf (thymePretty hms) thymeTime , bench "Chronos.builder_HMS" $ nf chronosPrettyHMS chronosTime ] + , bgroup "YmdHMS" + [ bench "Time.formatTime" $ nf (timePretty dmyhms) timeTime + , bench "Thyme.formatTime" $ nf (thymePretty dmyhms) thymeTime + , bench "Chronos.builder_YmdHMS" $ nf chronosPrettyYmdHMS chronosTime + ] ] ] @@ -111,3 +124,4 @@ deriving instance NFData Chronos.Month deriving instance NFData Chronos.Year deriving instance NFData Chronos.Day +deriving instance NFData Chronos.Time diff --git a/chronos.cabal b/chronos.cabal --- a/chronos.cabal +++ b/chronos.cabal @@ -2,7 +2,7 @@ name: chronos version: - 1.1 + 1.1.1 synopsis: A performant time library description: diff --git a/src/Chronos.hs b/src/Chronos.hs --- a/src/Chronos.hs +++ b/src/Chronos.hs @@ -7,6 +7,7 @@ , OverloadedStrings , RecordWildCards , ScopedTypeVariables + , TypeApplications , TypeFamilies , TypeInType , UnboxedTuples @@ -29,7 +30,7 @@ * Chronos uses normal non-overloaded haskell functions for encoding and decoding time. It provides parsers for both 'Text' and 'ByteString'. Additionally, Chronos provides functions for - encoding time to 'Text' or 'ByteString'. The http://hackage.haskell.org/package/time time> library accomplishes these with the + encoding time to 'Text' or 'ByteString'. The library accomplishes these with the module, which uses UNIX-style datetime format strings. The approach taken by Chronos is faster and catches more mistakes at compile time, at the cost of being @@ -43,6 +44,10 @@ , today , tomorrow , yesterday + , todayDayOfWeek + , yesterdayDayOfWeek + , tomorrowDayOfWeek + , timeToDayOfWeek , epoch -- ** Duration , stopwatch @@ -57,6 +62,7 @@ -- ** Conversion , timeToDatetime , datetimeToTime + , datetimeToDayOfWeek , timeToOffsetDatetime , offsetDatetimeToTime , timeToDayTruncate @@ -119,8 +125,11 @@ , builder_Dmy , builder_HMS , parser_Ymd + , parser_Ymd_lenient , parser_Mdy + , parser_Mdy_lenient , parser_Dmy + , parser_Dmy_lenient -- *** UTF-8 ByteString , builderUtf8_Ymd , parserUtf8_Ymd @@ -151,13 +160,31 @@ , encode_YmdHMS , encode_YmdIMS_p , parser_DmyHMS + , parser_DmyHMS_lenient , parser_YmdHMS + , parser_YmdHMS_lenient , parser_YmdHMS_opt_S + , parser_YmdHMS_opt_S_lenient , parser_DmyHMS_opt_S + , parser_DmyHMS_opt_S_lenient + , parser_MdyHMS + , parser_MdyHMS_lenient + , parser_MdyHMS_opt_S + , parser_MdyHMS_opt_S_lenient + , parser_lenient , decode_DmyHMS + , decode_DmyHMS_lenient + , decode_MdyHMS + , decode_MdyHMS_lenient + , decode_MdyHMS_opt_S + , decode_MdyHMS_opt_S_lenient , decode_YmdHMS + , decode_YmdHMS_lenient , decode_YmdHMS_opt_S + , decode_YmdHMS_opt_S_lenient , decode_DmyHMS_opt_S + , decode_DmyHMS_opt_S_lenient + , decode_lenient -- *** UTF-8 ByteString , encodeUtf8_YmdHMS , encodeUtf8_YmdIMS_p @@ -377,6 +404,16 @@ datetimeToTime :: Datetime -> Time datetimeToTime = fromUtc . datetimeToUtcTime +-- | Convert 'Datetime' to 'DayOfWeek' +datetimeToDayOfWeek :: Datetime -> DayOfWeek +datetimeToDayOfWeek (Datetime (Date year month date) _) = + let k = getDayOfMonth date + m = ((getMonth month + 10) `mod` 12) + 1 + y = adjustedYear `mod` 100 + c = adjustedYear `div` 100 + adjustedYear = if m >= 11 then getYear year - 1 else getYear year + in DayOfWeek $ (k + (floor $ ((2.6 :: Double) * fromIntegral m) - 0.2) - (2*c) + y + (y `div` 4) + (c `div` 4)) `mod` 7 + -- | Convert 'Time' to 'OffsetDatetime' by providing an 'Offset'. timeToOffsetDatetime :: Offset -> Time -> OffsetDatetime timeToOffsetDatetime offset = utcTimeToOffsetDatetime offset . toUtc @@ -489,6 +526,25 @@ now = fmap Time getPosixNanoseconds #endif +-- | Convert from 'Time' to 'DayOfWeek'. +timeToDayOfWeek :: Time -> DayOfWeek +timeToDayOfWeek (Time time) = DayOfWeek $ + (fromIntegral @Int64 @Int ((time `div` 86400000000000) + 4) `mod` 7) + +-- | Get the current 'DayOfWeek' from the system clock. +todayDayOfWeek :: IO DayOfWeek +todayDayOfWeek = timeToDayOfWeek <$> now + +-- | Get the yesterday\'s 'DayOfWeek' from the system clock. +yesterdayDayOfWeek :: IO DayOfWeek +yesterdayDayOfWeek = + timeToDayOfWeek . (add (Timespan (-86400000000000))) <$> now + +-- | Get the tomorrow\'s 'DayOfWeek' from the system clock. +tomorrowDayOfWeek :: IO DayOfWeek +tomorrowDayOfWeek = + timeToDayOfWeek . (add (Timespan (86400000000000))) <$> now + -- | The Unix epoch, that is 1970-01-01 00:00:00. epoch :: Time epoch = Time 0 @@ -937,6 +993,22 @@ when (d < 1 || d > 31) (fail "day must be between 1 and 31") pure (Date (Year y) (Month $ m - 1) (DayOfMonth d)) +-- | Parse a Year\/Month\/Day-encoded 'Date' that either has no separators or +-- uses any non-numeric character for each separator. +parser_Ymd_lenient :: Parser Date +parser_Ymd_lenient = do + y <- parseFixedDigits 4 + sep1 <- optional parserLenientSeparator + m <- parseFixedDigits 2 + when (m < 1 || m > 12) (fail "month must be between 1 and 12") + sep2 <- optional parserLenientSeparator + d <- parseFixedDigits 2 + when (d < 1 || d > 31) (fail "day must be between 1 and 31") + case (sep1, sep2) of + (Nothing, Just _) -> fail "Separators must all exist or not" + (Just _, Nothing) -> fail "Separators must all exist or not" + _ -> pure (Date (Year y) (Month $ m - 1) (DayOfMonth d)) + -- | Parse a Month\/Day\/Year-encoded 'Date' that uses the -- given separator. parser_Mdy :: Maybe Char -> Parser Date @@ -950,6 +1022,22 @@ y <- parseFixedDigits 4 pure (Date (Year y) (Month $ m - 1) (DayOfMonth d)) +-- | Parse a Month\/Day\/Year-encoded 'Date' that either has no separators or +-- uses any non-numeric character for each separator. +parser_Mdy_lenient :: Parser Date +parser_Mdy_lenient = do + m <- parseFixedDigits 2 + when (m < 1 || m > 12) (fail "month must be between 1 and 12") + sep1 <- optional parserLenientSeparator + d <- parseFixedDigits 2 + when (d < 1 || d > 31) (fail "day must be between 1 and 31") + sep2 <- optional parserLenientSeparator + y <- parseFixedDigits 4 + case (sep1, sep2) of + (Nothing, Just _) -> fail "Separators must all exist or not" + (Just _, Nothing) -> fail "Separators must all exist or not" + _ -> pure (Date (Year y) (Month $ m - 1) (DayOfMonth d)) + -- | Parse a Day\/Month\/Year-encoded 'Date' that uses the -- given separator. parser_Dmy :: Maybe Char -> Parser Date @@ -963,6 +1051,22 @@ y <- parseFixedDigits 4 pure (Date (Year y) (Month $ m - 1) (DayOfMonth d)) +-- | Parse a Day\/Month\/Year-encoded 'Date' that either has no separators or +-- uses any non-numeric character for each separator. +parser_Dmy_lenient :: Parser Date +parser_Dmy_lenient = do + d <- parseFixedDigits 2 + when (d < 1 || d > 31) (fail "day must be between 1 and 31") + sep1 <- optional parserLenientSeparator + m <- parseFixedDigits 2 + when (m < 1 || m > 12) (fail "month must be between 1 and 12") + sep2 <- optional parserLenientSeparator + y <- parseFixedDigits 4 + case (sep1, sep2) of + (Nothing, Just _) -> fail "Separators must all exist or not" + (Just _, Nothing) -> fail "Separators must all exist or not" + _ -> pure (Date (Year y) (Month $ m - 1) (DayOfMonth d)) + -- | Given a 'Date' and a separator, construct a 'ByteString' 'BB.Builder' -- corresponding to a Day\/Month\/Year encoding. builderUtf8_Ymd :: Maybe Char -> Date -> BB.Builder @@ -1045,6 +1149,22 @@ ns <- parseSecondsAndNanoseconds pure (TimeOfDay h m ns) +parserLenientSeparator :: Parser () +parserLenientSeparator = AT.satisfy (not . isDigit) *> pure () + +-- | Parse an Hour\/Minute\/Second-encoded 'TimeOfDay' that either has no +-- separators or uses any given non-numeric character for each separator. +parser_HMS_lenient :: Parser TimeOfDay +parser_HMS_lenient = do + h <- parseFixedDigits 2 + when (h > 23) (fail "hour must be between 0 and 23") + parserLenientSeparator + m <- parseFixedDigits 2 + when (m > 59) (fail "minute must be between 0 and 59") + parserLenientSeparator + ns <- parseSecondsAndNanoseconds + pure (TimeOfDay h m ns) + -- | Parses text that is formatted as either of the following: -- -- * @%H:%M@ @@ -1080,6 +1200,33 @@ pure (TimeOfDay h m ns) else pure (TimeOfDay h m 0) +-- | Parses text that is formatted as either of the following with either no +-- separators or any non-numeric characters for each separator: +-- +-- * @%H:%M@ +-- * @%H:%M:%S@ +-- +-- That is, the seconds and subseconds part is optional. If it is +-- not provided, it is assumed to be zero. This format shows up +-- in Google Chrome\'s @datetime-local@ inputs. +parser_HMS_opt_S_lenient :: Parser TimeOfDay +parser_HMS_opt_S_lenient = do + h <- parseFixedDigits 2 + when (h > 23) (fail "hour must be between 0 and 23") + parserLenientSeparator + m <- parseFixedDigits 2 + when (m > 59) (fail "minute must be between 0 and 59") + mc <- AT.peekChar + case mc of + Nothing -> pure (TimeOfDay h m 0) + Just c | not (isDigit c) -> do + _ <- AT.anyChar -- should be the separator + ns <- parseSecondsAndNanoseconds + pure (TimeOfDay h m ns) + Just _ -> do + ns <- parseSecondsAndNanoseconds + pure (TimeOfDay h m ns) + parseSecondsAndNanoseconds :: Parser Int64 parseSecondsAndNanoseconds = do s' <- parseFixedDigits 2 @@ -1289,6 +1436,13 @@ decode_YmdHMS format = either (const Nothing) Just . AT.parseOnly (parser_YmdHMS format) +-- | Decode a Year\/Month\/Day,Hour\/Minute\/Second-encoded 'Datetime' from +-- 'Text' that was encoded with either no separators or any non-numeric +-- character for each separator. +decode_YmdHMS_lenient :: Text -> Maybe Datetime +decode_YmdHMS_lenient = + either (const Nothing) Just . AT.parseOnly parser_YmdHMS_lenient + -- | Parse a Day\/Month\/Year,Hour\/Minute\/Second-encoded 'Datetime' -- that was encoded with the given 'DatetimeFormat'. parser_DmyHMS :: DatetimeFormat -> Parser Datetime @@ -1313,13 +1467,58 @@ time <- parser_HMS_opt_S mtimeSep pure (Datetime date time) +-- | Parse a Day\/Month\/Year,Hour\/Minute\/Second-encoded 'Datetime' from +-- 'Text' that was encoded with either no separators or any non-numeric +-- character for each separator, such as: +-- +-- 01-05-2017T23:13:05 +-- 01-05-2017 23:13:05 +-- 01/05/2017 23:13:05 +-- 01y01/2018x23;50&29 +parser_DmyHMS_lenient :: Parser Datetime +parser_DmyHMS_lenient = do + mdate <- optional $ parser_Dmy Nothing + case mdate of + Just date -> Datetime date <$> parser_HMS Nothing + Nothing -> Datetime <$> parser_Dmy_lenient <* parserLenientSeparator <*> parser_HMS_lenient + +-- | Parse a Day\/Month\/Year,Hour\/Minute\/Second-encoded 'Datetime' from +-- 'Text' that was encoded with either no separators or any non-numeric +-- character for each separator and with either of the following time formats: +-- +-- * @%H:%M@ +-- * @%H:%M:%S@ +-- +-- That is, the seconds and subseconds part is optional. If it is +-- not provided, it is assumed to be zero. This format shows up +-- in Google Chrome\'s @datetime-local@ inputs. +parser_DmyHMS_opt_S_lenient :: Parser Datetime +parser_DmyHMS_opt_S_lenient = do + mdate <- optional $ parser_Dmy Nothing + case mdate of + Just date -> Datetime date <$> parser_HMS_opt_S Nothing + Nothing -> Datetime <$> parser_Dmy_lenient <* parserLenientSeparator <*> parser_HMS_opt_S_lenient + +-- | Decodes Day\/Month\/Year,Hour\/Minute\/Second-encoded 'Datetime' from +-- 'Text' that is encoded with either no separators or any non-numeric +-- characters as separators, such as: +-- +-- 2017-01-05T23:13:05 +-- 2017-01-05 23:13:05 +-- 2017/01/05 23:13:05 +-- 2018x01y01/23;50&29 +decode_DmyHMS_lenient :: Text -> Maybe Datetime +decode_DmyHMS_lenient = either (const Nothing) Just . AT.parseOnly parser_DmyHMS_lenient + -- | Decode a Day\/Month\/Year,Hour\/Minute\/Second-encoded 'Datetime' -- from 'Text' that was encoded with the given 'DatetimeFormat'. decode_DmyHMS :: DatetimeFormat -> Text -> Maybe Datetime decode_DmyHMS format = either (const Nothing) Just . AT.parseOnly (parser_DmyHMS format) --- | Parses text that is formatted as either of the following: +-- | Decode a Day\/Month\/Year,Hour\/Minute\/Second-encoded 'Datetime' from +-- 'Text' that was encoded with with the given 'DatetimeFormat' and with +-- either of the following time formats: -- -- * @%H:%M@ -- * @%H:%M:%S@ @@ -1330,6 +1529,112 @@ decode_DmyHMS_opt_S :: DatetimeFormat -> Text -> Maybe Datetime decode_DmyHMS_opt_S format = either (const Nothing) Just . AT.parseOnly (parser_DmyHMS_opt_S format) + +-- | Decode a Day\/Month\/Year,Hour\/Minute\/Second-encoded 'Datetime' from +-- 'Text' that was encoded with either no separators or any non-numeric +-- character for each separator and with either of the following time formats: +-- +-- * @%H:%M@ +-- * @%H:%M:%S@ +-- +-- That is, the seconds and subseconds part is optional. If it is +-- not provided, it is assumed to be zero. This format shows up +-- in Google Chrome\'s @datetime-local@ inputs. +decode_DmyHMS_opt_S_lenient :: Text -> Maybe Datetime +decode_DmyHMS_opt_S_lenient = + either (const Nothing) Just . AT.parseOnly parser_DmyHMS_opt_S_lenient + + +-- | Parses a Month\/Day\/Year,Hour\/Minute\/Second-encoded 'Datetime' +-- that was encoded using the given 'DatetimeFormat'. +parser_MdyHMS :: DatetimeFormat -> Parser Datetime +parser_MdyHMS (DatetimeFormat mdateSep msep mtimeSep) = do + date <- parser_Mdy mdateSep + traverse_ AT.char msep + time <- parser_HMS mtimeSep + pure (Datetime date time) + +-- | Parses a Month\/Day\/Year,Hour\/Minute\/Second-encoded 'Datetime' that was +-- encoded with either no separators or any non-numeric character for each +-- separator. +parser_MdyHMS_lenient :: Parser Datetime +parser_MdyHMS_lenient = do + mdate <- optional $ parser_Mdy Nothing + case mdate of + Just date -> Datetime date <$> parser_HMS Nothing + Nothing -> Datetime <$> parser_Mdy_lenient <* parserLenientSeparator <*> parser_HMS_lenient + +-- | Parse a Month\/Day\/Year,Hour\/Minute\/Second-encoded 'Datetime' from +-- 'Text' that was encoded with with the given 'DatetimeFormat' and with +-- either of the following time formats: +-- +-- * @%H:%M@ +-- * @%H:%M:%S@ +-- +-- That is, the seconds and subseconds part is optional. If it is +-- not provided, it is assumed to be zero. +parser_MdyHMS_opt_S :: DatetimeFormat -> Parser Datetime +parser_MdyHMS_opt_S (DatetimeFormat mdateSep msep mtimeSep) = do + date <- parser_Mdy mdateSep + traverse_ AT.char msep + time <- parser_HMS_opt_S mtimeSep + pure (Datetime date time) + +-- | Parse a Month\/Day\/Year,Hour\/Minute\/Second-encoded 'Datetime' from +-- 'Text' that was encoded with either no separators or any non-numeric +-- character for each separator and with either of the following time formats: +-- +-- * @%H:%M@ +-- * @%H:%M:%S@ +-- +-- That is, the seconds and subseconds part is optional. If it is +-- not provided, it is assumed to be zero. +parser_MdyHMS_opt_S_lenient :: Parser Datetime +parser_MdyHMS_opt_S_lenient = do + mdate <- optional $ parser_Mdy Nothing + case mdate of + Just date -> Datetime date <$> parser_HMS_opt_S Nothing + Nothing -> Datetime <$> parser_Mdy_lenient <* parserLenientSeparator <*> parser_HMS_opt_S_lenient + +-- | Decode a Month\/Day\/Year,Hour\/Minute\/Second-encoded 'Datetime' +-- from 'Text' that was encoded with the given 'DatetimeFormat'. +decode_MdyHMS :: DatetimeFormat -> Text -> Maybe Datetime +decode_MdyHMS format = + either (const Nothing) Just . AT.parseOnly (parser_MdyHMS format) + +-- | Decode a Month\/Day\/Year,Hour\/Minute\/Second-encoded 'Datetime' from +-- 'Text' with either no separators or any non-numeric character for each +-- separator. +decode_MdyHMS_lenient :: Text -> Maybe Datetime +decode_MdyHMS_lenient = + either (const Nothing) Just . AT.parseOnly parser_MdyHMS_lenient + +-- | Decode a Month\/Day\/Year,Hour\/Minute\/Second-encoded 'Datetime' from +-- 'Text' that was encoded with the given 'DatetimeFormat' and with either of +-- the following time formats: +-- +-- * @%H:%M@ +-- * @%H:%M:%S@ +-- +-- That is, the seconds and subseconds part is optional. If it is +-- not provided, it is assumed to be zero. +decode_MdyHMS_opt_S :: DatetimeFormat -> Text -> Maybe Datetime +decode_MdyHMS_opt_S format = + either (const Nothing) Just . AT.parseOnly (parser_MdyHMS_opt_S format) + +-- | Parse a Month\/Day\/Year,Hour\/Minute\/Second-encoded 'Datetime' from +-- 'Text' with either no separators or any non-numeric character for each +-- separator and with either of the following time formats: +-- +-- * @%H:%M@ +-- * @%H:%M:%S@ +-- +-- That is, the seconds and subseconds part is optional. If it is +-- not provided, it is assumed to be zero. +decode_MdyHMS_opt_S_lenient :: Text -> Maybe Datetime +decode_MdyHMS_opt_S_lenient = + either (const Nothing) Just . AT.parseOnly parser_MdyHMS_opt_S_lenient + -- | Parses a Year\/Month\/Day,Hour\/Minute\/Second-encoded 'Datetime' -- that was encoded using the given 'DatetimeFormat'. parser_YmdHMS :: DatetimeFormat -> Parser Datetime @@ -1339,7 +1644,19 @@ time <- parser_HMS mtimeSep pure (Datetime date time) --- | Parses text that is formatted as either of the following: +-- | Parses a Year\/Month\/Day,Hour\/Minute\/Second-encoded 'Datetime' that was +-- encoded with either no separators or any non-numeric character for each +-- separator. +parser_YmdHMS_lenient :: Parser Datetime +parser_YmdHMS_lenient = do + mdate <- optional $ parser_Ymd Nothing + case mdate of + Just date -> Datetime date <$> parser_HMS Nothing + Nothing -> Datetime <$> parser_Ymd_lenient <* parserLenientSeparator <*> parser_HMS_lenient + +-- | Parses a Year\/Month\/Date,Hour\/Minute\/Second-encoded 'Datetime' from +-- 'Text' that was encoded with the given 'DatetimeFormat' and with either of +-- the following time formats: -- -- * @%H:%M@ -- * @%H:%M:%S@ @@ -1354,7 +1671,9 @@ time <- parser_HMS_opt_S mtimeSep pure (Datetime date time) --- | Parses text that is formatted as either of the following: +-- | Parses a Year\/Month\/Date,Hour\/Minute\/Second-encoded 'Datetime' from +-- 'Text' that was encoded with either no separators or any non-numeric +-- character for each separator and with either of the following time formats: -- -- * @%H:%M@ -- * @%H:%M:%S@ @@ -1362,9 +1681,63 @@ -- That is, the seconds and subseconds part is optional. If it is -- not provided, it is assumed to be zero. This format shows up -- in Google Chrome\'s @datetime-local@ inputs. +parser_YmdHMS_opt_S_lenient :: Parser Datetime +parser_YmdHMS_opt_S_lenient = do + mdate <- optional $ parser_Ymd Nothing + case mdate of + Just date -> Datetime date <$> parser_HMS_opt_S Nothing + Nothing -> Datetime <$> parser_Ymd_lenient <* parserLenientSeparator <*> parser_HMS_opt_S_lenient + +-- | Decode a Year\/Month\/Date,Hour\/Minute\/Second-encoded 'Datetime' from +-- 'Text' that was encoded with the given 'DatetimeFormat' and with either of +-- the following time formats: +-- +-- * @%H:%M@ +-- * @%H:%M:%S@ +-- +-- That is, the seconds and subseconds part is optional. If it is +-- not provided, it is assumed to be zero. This format shows up +-- in Google Chrome\'s @datetime-local@ inputs. decode_YmdHMS_opt_S :: DatetimeFormat -> Text -> Maybe Datetime decode_YmdHMS_opt_S format = either (const Nothing) Just . AT.parseOnly (parser_YmdHMS_opt_S format) + +-- | Decode a Year\/Month\/Date,Hour\/Minute\/Second-encoded 'Datetime' from +-- 'Text' that was encoded with either no separators or any non-numeric +-- character for each separator and with either of the following time formats: +-- +-- * @%H:%M@ +-- * @%H:%M:%S@ +-- +-- That is, the seconds and subseconds part is optional. If it is +-- not provided, it is assumed to be zero. This format shows up +-- in Google Chrome\'s @datetime-local@ inputs. +decode_YmdHMS_opt_S_lenient :: Text -> Maybe Datetime +decode_YmdHMS_opt_S_lenient = + either (const Nothing) Just . AT.parseOnly parser_YmdHMS_opt_S_lenient + +-- | Parses a 'Datetime' from 'Text' that was encoded with any of the following +-- formats and with either no separators or any non-numeric character for each +-- separator. +-- +-- * @%Y-%M-%D %H:%M@ +-- * @%Y-%M-%D %H:%M:%S@ +-- * @%D-%M-%Y %H:%M@ +-- * @%D-%M-%Y %H:%M:%S@ +-- * @%M-%D-%Y %H:%M@ +-- * @%M-%D-%Y %H:%M:%S@ +-- +-- That is, the seconds and subseconds part is optional. If it is not provided, +-- it is assumed to be zero. Note that this is the least performant parser due +-- to backtracking +parser_lenient :: Parser Datetime +parser_lenient = parser_YmdHMS_opt_S_lenient <|> parser_DmyHMS_opt_S_lenient <|> parser_MdyHMS_opt_S_lenient + +-- | Parses text that was encoded in DMY, YMD, or MDY format with optional +-- seconds and any non-numeric character as separators. +decode_lenient :: Text -> Maybe Datetime +decode_lenient = + either (const Nothing) Just . AT.parseOnly parser_lenient --------------- -- ByteString stuff --------------- diff --git a/src/Chronos/Internal/CTimespec.hs b/src/Chronos/Internal/CTimespec.hs --- a/src/Chronos/Internal/CTimespec.hs +++ b/src/Chronos/Internal/CTimespec.hs @@ -57,6 +57,8 @@ throwErrnoIfMinus1_ "clock_gettime" $ clock_gettime 0 ptspec peek ptspec - return ((s * 1000000000) + ns) + -- On most 64-bit platforms, the uses of fromIntegral here end up + -- being i64->i64, but on 32-bit platforms, they are i32->i64. + return ((fromIntegral s * 1000000000) + fromIntegral ns) #endif diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -122,14 +122,46 @@ ] ] , testGroup "Date" - [ testGroup "Parser Spec Tests" $ - [ PH.testCase "No Separator" - (dateParse Nothing "20160101" (Date (Year 2016) (Month 0) (DayOfMonth 1))) - , PH.testCase "Separator 1" - (dateParse (Just '-') "2016-01-01" (Date (Year 2016) (Month 0) (DayOfMonth 1))) - , PH.testCase "Separator 2" - (dateParse (Just '-') "1876-09-27" (Date (Year 1876) (Month 8) (DayOfMonth 27))) + [ testGroup "Ymd Parser Spec Tests" $ + [ PH.testCase "Passes With No Separator" + (dateParse (C.parser_Ymd Nothing) "20160101" (Date (Year 2016) (Month 0) (DayOfMonth 1))) + , PH.testCase "Passes With Separator 1" + (dateParse (C.parser_Ymd (Just '-')) "2016-01-01" (Date (Year 2016) (Month 0) (DayOfMonth 1))) + , PH.testCase "Passes With Separator 2" + (dateParse (C.parser_Ymd (Just '-')) "1876-09-27" (Date (Year 1876) (Month 8) (DayOfMonth 27))) ] + , testGroup "Dmy Parser Spec Tests" $ + [ PH.testCase "Passes With No Separator" + (dateParse (C.parser_Dmy Nothing) "01012016" (Date (Year 2016) (Month 0) (DayOfMonth 1))) + , PH.testCase "Passes With Separator 1" + (dateParse (C.parser_Dmy (Just '-')) "01-01-2016" (Date (Year 2016) (Month 0) (DayOfMonth 1))) + , PH.testCase "Passes With Separator 2" + (dateParse (C.parser_Dmy (Just '-')) "27-09-1876" (Date (Year 1876) (Month 8) (DayOfMonth 27))) + ] + , testGroup "Ymd Lenient Parser Spec Tests" $ + [ PH.testCase "Passes With No Separator" + (dateParse C.parser_Ymd_lenient "20160101" (Date (Year 2016) (Month 0) (DayOfMonth 1))) + , PH.testCase "Passes With Separator 1" + (dateParse C.parser_Ymd_lenient "2016!01@01" (Date (Year 2016) (Month 0) (DayOfMonth 1))) + , PH.testCase "Passes With Separator 2" + (dateParse C.parser_Ymd_lenient "1876z09+27" (Date (Year 1876) (Month 8) (DayOfMonth 27))) + ] + , testGroup "Dmy Lenient Parser Spec Tests" $ + [ PH.testCase "Passes With No Separator" + (dateParse C.parser_Dmy_lenient "01012016" (Date (Year 2016) (Month 0) (DayOfMonth 1))) + , PH.testCase "Passes With Separator 1" + (dateParse C.parser_Dmy_lenient "01!01@2016" (Date (Year 2016) (Month 0) (DayOfMonth 1))) + , PH.testCase "Passes With Separator 2" + (dateParse C.parser_Dmy_lenient "27z09+1876" (Date (Year 1876) (Month 8) (DayOfMonth 27))) + ] + , testGroup "Mdy Lenient Parser Spec Tests" $ + [ PH.testCase "Passes With No Separator" + (dateParse C.parser_Mdy_lenient "01022016" (Date (Year 2016) (Month 0) (DayOfMonth 2))) + , PH.testCase "Passes With Separator 1" + (dateParse C.parser_Mdy_lenient "01!02@2016" (Date (Year 2016) (Month 0) (DayOfMonth 2))) + , PH.testCase "Passes With Separator 2" + (dateParse C.parser_Mdy_lenient "09+27z1876" (Date (Year 1876) (Month 8) (DayOfMonth 27))) + ] , testGroup "Builder Spec Tests" $ [ PH.testCase "No Separator" (dateBuilder Nothing "20160101" (Date (Year 2016) (Month 0) (DayOfMonth 1))) @@ -143,12 +175,214 @@ (either (const Nothing) Just . Atto.parseOnly (C.parser_Ymd (Just '-'))) ] , testGroup "Datetime" - [ testProperty "Builder Parser Isomorphism (Y-m-dTH:M:S)" $ propEncodeDecodeIsoSettings - (\format -> LText.toStrict . Builder.toLazyText . C.builder_YmdHMS (SubsecondPrecisionFixed 9) format) - (\format -> either (const Nothing) Just . Atto.parseOnly (C.parser_YmdHMS format)) - , testProperty "Builder Parser Isomorphism (YmdHMS)" $ propEncodeDecodeIso - (LText.toStrict . Builder.toLazyText . C.builder_YmdHMS (SubsecondPrecisionFixed 9) (DatetimeFormat Nothing Nothing Nothing)) - (either (const Nothing) Just . Atto.parseOnly (C.parser_YmdHMS (DatetimeFormat Nothing Nothing Nothing))) + [ testGroup "DmyHMS Parser Spec Tests" $ + [ PH.testCase "Passes With No Separator" + (datetimeParse (C.parser_DmyHMS (DatetimeFormat Nothing Nothing Nothing)) "01022016010223" $ + Datetime (Date (Year 2016) (Month 1) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000) + ) + , PH.testCase "Passes With With Separator" + (datetimeParse (C.parser_DmyHMS (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "01-02-2016 01:02:23" $ + Datetime (Date (Year 2016) (Month 1) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000) + ) + ] + , testGroup "YmdHMS Parser Spec Tests" $ + [ PH.testCase "Passes With No Separator" + (datetimeParse (C.parser_YmdHMS (DatetimeFormat Nothing Nothing Nothing)) "20160101010223" $ + Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000) + ) + , PH.testCase "Passes With With Separator" + (datetimeParse (C.parser_YmdHMS (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "2016-01-01 01:02:23" $ + Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000) + ) + ] + , testGroup "MdyHMS Parser Spec Tests" $ + [ PH.testCase "Passes With No Separator" + (datetimeParse (C.parser_MdyHMS (DatetimeFormat Nothing Nothing Nothing)) "01012016010223" $ + Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000) + ) + , PH.testCase "Passes With With Separator" + (datetimeParse (C.parser_MdyHMS (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "01-01-2016 01:02:23" $ + Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000) + ) + ] + , testGroup "DmyHMS Lenient Parser Spec Tests" $ + [ PH.testCase "Passes With No Separator" + (datetimeParse C.parser_DmyHMS_lenient "01022016010223" $ + Datetime (Date (Year 2016) (Month 1) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000) + ) + , PH.testCase "Passes With With Separator" + (datetimeParse C.parser_DmyHMS_lenient "01z02x2016$01;02:23" $ + Datetime (Date (Year 2016) (Month 1) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000) + ) + , PH.testCase "Fails with extra seperators" + (datetimeParseFail C.parser_DmyHMS_lenient "01-02-2016 01:02:23" "Failed reading: input does not start with a digit") + , PH.testCase "Fails with some nonuniform empty Separators" + (datetimeParseFail C.parser_DmyHMS_lenient "01-02-201601:02:23" "Failed reading: satisfy") + ] + , testGroup "YmdHMS Lenient Parser Spec Tests" $ + [ PH.testCase "Passes With No Separator" + (datetimeParse C.parser_YmdHMS_lenient "20160101010223" $ + Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000) + ) + , PH.testCase "Passes With With Separator" + (datetimeParse C.parser_YmdHMS_lenient "2016!01z01^01a02c23" $ + Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000) + ) + , PH.testCase "Fails with extra seperators" + (datetimeParseFail C.parser_YmdHMS_lenient "2016-01-02 01:02:03" "Failed reading: input does not start with a digit") + ] + , testGroup "MdyHMS Lenient Parser Spec Tests" $ + [ PH.testCase "Passes With No Separator" + (datetimeParse C.parser_MdyHMS_lenient "01012016010223" $ + Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000) + ) + , PH.testCase "Passes With With Separator" + (datetimeParse C.parser_MdyHMS_lenient "01z01%2016^01a02c23" $ + Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000) + ) + , PH.testCase "Fails with extra seperators" + (datetimeParseFail C.parser_MdyHMS_lenient "01-02-2016 01:02:03" "Failed reading: input does not start with a digit") + ] + , testGroup "DmyHMS Optional Seconds Parser Spec Tests" $ + [ PH.testCase "Passes With No Separator With Seconds" + (datetimeParse (C.parser_DmyHMS_opt_S (DatetimeFormat Nothing Nothing Nothing)) "01022016010223" $ + Datetime (Date (Year 2016) (Month 1) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000) + ) + , PH.testCase "Passes With No Separator Without Seconds" + (datetimeParse (C.parser_DmyHMS_opt_S (DatetimeFormat Nothing Nothing Nothing)) "010220160102" $ + Datetime (Date (Year 2016) (Month 1) (DayOfMonth 1)) (TimeOfDay 01 02 0) + ) + , PH.testCase "Passes With With Separator With Seconds" + (datetimeParse (C.parser_DmyHMS_opt_S (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "01-02-2016 01:02:23" $ + Datetime (Date (Year 2016) (Month 1) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000) + ) + , PH.testCase "Passes With With Separator Without Seconds" + (datetimeParse (C.parser_DmyHMS_opt_S (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "01-02-2016 01:02" $ + Datetime (Date (Year 2016) (Month 1) (DayOfMonth 1)) (TimeOfDay 01 02 0) + ) + , PH.testCase "Fails with trailing seperator" + (datetimeParseFail (C.parser_DmyHMS_opt_S (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "01-02-2016 01:02:" "not enough input") + , PH.testCase "Fails with extra seperators" + (datetimeParseFail (C.parser_DmyHMS_opt_S (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "01-02-2016 01:02" "Failed reading: input does not start with a digit") + ] + , testGroup "YmdHMS Optional Parser Spec Tests" $ + [ PH.testCase "Passes With No Separator With Seconds" + (datetimeParse (C.parser_YmdHMS_opt_S (DatetimeFormat Nothing Nothing Nothing)) "20160101010223" $ + Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000) + ) + , PH.testCase "Passes With No Separator Without Seconds" + (datetimeParse (C.parser_YmdHMS_opt_S (DatetimeFormat Nothing Nothing Nothing)) "201601010102" $ + Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 0) + ) + , PH.testCase "Passes With With Separator With Seconds" + (datetimeParse (C.parser_YmdHMS_opt_S (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "2016-01-01 01:02:23" $ + Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000) + ) + , PH.testCase "Passes With With Separator Without Seconds" + (datetimeParse (C.parser_YmdHMS_opt_S (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "2016-01-01 01:02" $ + Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 0) + ) + , PH.testCase "Fails with trailing seperator" + (datetimeParseFail (C.parser_YmdHMS_opt_S (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "2016-01-02 01:02:" "not enough input") + , PH.testCase "Fails with extra seperators" + (datetimeParseFail (C.parser_YmdHMS_opt_S (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "2016-01-02 01:02" "Failed reading: input does not start with a digit") + ] + , testGroup "MdyHMS Optional Parser Spec Tests" $ + [ PH.testCase "Passes With No Separator With Seconds" + (datetimeParse (C.parser_MdyHMS_opt_S (DatetimeFormat Nothing Nothing Nothing)) "01012016010223" $ + Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000) + ) + , PH.testCase "Passes With No Separator Without Seconds" + (datetimeParse (C.parser_MdyHMS_opt_S (DatetimeFormat Nothing Nothing Nothing)) "010120160102" $ + Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 0) + ) + , PH.testCase "Passes With With Separator With Seconds" + (datetimeParse (C.parser_MdyHMS_opt_S (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "01-01-2016 01:02:23" $ + Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000) + ) + , PH.testCase "Passes With With Separator Without Seconds" + (datetimeParse (C.parser_MdyHMS_opt_S (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "01-01-2016 01:02" $ + Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 0) + ) + , PH.testCase "Fails with trailing seperator" + (datetimeParseFail (C.parser_MdyHMS_opt_S (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "01-02-2016 01:02:" "not enough input") + , PH.testCase "Fails with extra seperators" + (datetimeParseFail (C.parser_MdyHMS_opt_S (DatetimeFormat (Just '-') (Just ' ') (Just ':'))) "01-02-2016 01:02" "Failed reading: input does not start with a digit") + ] + , testGroup "DmyHMS Optional Seconds Lenient Parser Spec Tests" $ + [ PH.testCase "Passes With No Separator with seconds" + (datetimeParse C.parser_DmyHMS_opt_S_lenient "01022016010223" $ + Datetime (Date (Year 2016) (Month 1) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000) + ) + , PH.testCase "Passes With No Separator without seconds" + (datetimeParse C.parser_DmyHMS_opt_S_lenient "010220160102" $ + Datetime (Date (Year 2016) (Month 1) (DayOfMonth 1)) (TimeOfDay 01 02 0) + ) + , PH.testCase "Passes With With Separator with seconds" + (datetimeParse C.parser_DmyHMS_opt_S_lenient "01z02x2016$01;02:23" $ + Datetime (Date (Year 2016) (Month 1) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000) + ) + , PH.testCase "Passes With With Separator without seconds" + (datetimeParse C.parser_DmyHMS_opt_S_lenient "01z02x2016$01;02" $ + Datetime (Date (Year 2016) (Month 1) (DayOfMonth 1)) (TimeOfDay 01 02 0) + ) + , PH.testCase "Fails with trailing seperator" + (datetimeParseFail C.parser_DmyHMS_opt_S_lenient "01z02x2016$01;02^" "not enough input") + , PH.testCase "Fails with extra seperators" + (datetimeParseFail C.parser_DmyHMS_opt_S_lenient "01-02-2016 01:02" "Failed reading: input does not start with a digit") + ] + , testGroup "YmdHMS Optional Seconds Lenient Parser Spec Tests" $ + [ PH.testCase "Passes With No Separator With Seconds" + (datetimeParse C.parser_YmdHMS_opt_S_lenient "20160101010223" $ + Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000) + ) + , PH.testCase "Passes With No Separator Without Seconds" + (datetimeParse C.parser_YmdHMS_opt_S_lenient "201601010102" $ + Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 0) + ) + , PH.testCase "Passes With With Separator With Seconds" + (datetimeParse C.parser_YmdHMS_opt_S_lenient "2016!01z01^01a02c23" $ + Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000) + ) + , PH.testCase "Passes With With Separator Without Seconds" + (datetimeParse C.parser_YmdHMS_opt_S_lenient "2016!01z01^01a02" $ + Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 0) + ) + , PH.testCase "Fails with trailing seperator" + (datetimeParseFail C.parser_YmdHMS_opt_S_lenient "2016!01z01^01a02^" "not enough input") + , PH.testCase "Fails with extra seperators" + (datetimeParseFail C.parser_YmdHMS_opt_S_lenient "2016-01-02 01:02" "Failed reading: input does not start with a digit") + ] + , testGroup "MdyHMS Optional Seconds Lenient Parser Spec Tests" $ + [ PH.testCase "Passes With No Separator With Seconds" + (datetimeParse C.parser_MdyHMS_opt_S_lenient "01012016010223" $ + Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000) + ) + , PH.testCase "Passes With No Separator Without Seconds" + (datetimeParse C.parser_MdyHMS_opt_S_lenient "010120160102" $ + Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 0) + ) + , PH.testCase "Passes With With Separator With Seconds" + (datetimeParse C.parser_MdyHMS_opt_S_lenient "01z01!2016^01a02c23" $ + Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 23000000000) + ) + , PH.testCase "Passes With With Separator Without Seconds" + (datetimeParse C.parser_MdyHMS_opt_S_lenient "01z01(2016^01a02" $ + Datetime (Date (Year 2016) (Month 0) (DayOfMonth 1)) (TimeOfDay 01 02 0) + ) + , PH.testCase "Fails with trailing seperator" + (datetimeParseFail C.parser_MdyHMS_opt_S_lenient "01z01!2016^01a02^" "not enough input") + , PH.testCase "Fails with extra seperators" + (datetimeParseFail C.parser_MdyHMS_opt_S_lenient "01-02-2016 01:02" "Failed reading: input does not start with a digit") + ] + , testGroup "Builder Parser Isomorphism" $ + [ testProperty "(Y-m-dTH:M:S)" $ propEncodeDecodeIsoSettings + (\format -> LText.toStrict . Builder.toLazyText . C.builder_YmdHMS (SubsecondPrecisionFixed 9) format) + (\format -> either (const Nothing) Just . Atto.parseOnly (C.parser_YmdHMS format)) + , testProperty "Builder Parser Isomorphism (YmdHMS)" $ propEncodeDecodeIso + (LText.toStrict . Builder.toLazyText . C.builder_YmdHMS (SubsecondPrecisionFixed 9) (DatetimeFormat Nothing Nothing Nothing)) + (either (const Nothing) Just . Atto.parseOnly (C.parser_YmdHMS (DatetimeFormat Nothing Nothing Nothing))) + ] ] , testGroup "Offset Datetime" [ testGroup "Builder Spec Tests" $ @@ -212,6 +446,40 @@ [ testProperty "Verify TimeInterval construction correctness" propTimeIntervalBuilder ] ] + , testGroup "Datetime Conversions" + [ testGroup "datetimeToDayOfWeek" + [ PH.testCase "February 2nd 2020" + (C.datetimeToDayOfWeek (Datetime (Date (Year 2020) (Month 1) (DayOfMonth 2)) (TimeOfDay 0 0 0)) @?= DayOfWeek 0) + , PH.testCase "July 10th 2019" + (C.datetimeToDayOfWeek (Datetime (Date (Year 2019) (Month 6) (DayOfMonth 10)) (TimeOfDay 0 0 0)) @?= DayOfWeek 3) + , PH.testCase "November 16th 1946" + (C.datetimeToDayOfWeek (Datetime (Date (Year 1946) (Month 10) (DayOfMonth 16)) (TimeOfDay 0 0 0)) @?= DayOfWeek 6) + , PH.testCase "February 29th 2024 (Leap Year)" + (C.datetimeToDayOfWeek (Datetime (Date (Year 2024) (Month 1) (DayOfMonth 29)) (TimeOfDay 0 0 0)) @?= DayOfWeek 4) + ] + ] + , testGroup "timeToDayOfWeek Conversions" + [ PH.testCase "Sunday, February 9, 2020 4:00:00 PM" + (C.timeToDayOfWeek (Time 1581264000000000000) @?= DayOfWeek 0) + , PH.testCase "Monday, April 9, 2001 4:00:00 PM" + (C.timeToDayOfWeek (Time 986832000000000000) @?= DayOfWeek 1) + , PH.testCase "Tuesday, March 7, 1995 4:00:00 PM" + (C.timeToDayOfWeek (Time 794592000000000000) @?= DayOfWeek 2) + , PH.testCase "Wednesday, June 17, 1987 4:00:00 PM" + (C.timeToDayOfWeek (Time 550944000000000000) @?= DayOfWeek 3) + , PH.testCase "Thursday, December 18, 1980 4:00:00 PM" + (C.timeToDayOfWeek (Time 346003200000000000) @?= DayOfWeek 4) + , PH.testCase "Friday, October 10, 1975 4:00:00 PM" + (C.timeToDayOfWeek (Time 182188800000000000) @?= DayOfWeek 5) + , PH.testCase "Saturday, August 11, 1973 4:00:00 PM" + (C.timeToDayOfWeek (Time 113932800000000000) @?= DayOfWeek 6) + , PH.testCase "Thursday, January 1, 1970 12:00:00 AM" + (C.timeToDayOfWeek (Time 0) @?= DayOfWeek 4) + , PH.testCase "Saturday, June 14, 1969 4:00:00 PM" + (C.timeToDayOfWeek (Time (-17308800000000000)) @?= DayOfWeek 6) + , PH.testCase "Tuesday, June 6, 1944 4:00:00 PM" + (C.timeToDayOfWeek (Time (-806918400000000000)) @?= DayOfWeek 2) + ] ] failure :: String -> Result @@ -279,10 +547,25 @@ LText.toStrict (Builder.toLazyText (C.builder_HMS sp m tod)) @?= expected -dateParse :: Maybe Char -> Text -> Date -> Assertion -dateParse m t expected = - Atto.parseOnly (C.parser_Ymd m <* Atto.endOfInput) t +dateParse :: Atto.Parser Date -> Text -> Date -> Assertion +dateParse p t expected = + Atto.parseOnly (p <* Atto.endOfInput) t @?= Right expected + +--dateParseFail :: Atto.Parser Date -> Text -> String -> Assertion +--dateParseFail p t expected = +-- Atto.parseOnly (p <* Atto.endOfInput) t +-- @?= Left expected + +datetimeParse :: Atto.Parser Datetime -> Text -> Datetime -> Assertion +datetimeParse p t expected = + Atto.parseOnly (p <* Atto.endOfInput) t + @?= Right expected + +datetimeParseFail :: Atto.Parser Datetime -> Text -> String -> Assertion +datetimeParseFail p t expected = + Atto.parseOnly (p <* Atto.endOfInput) t + @?= Left expected dateBuilder :: Maybe Char -> Text -> Date -> Assertion dateBuilder m expected tod =