diff --git a/chronos.cabal b/chronos.cabal --- a/chronos.cabal +++ b/chronos.cabal @@ -1,5 +1,5 @@ name: chronos -version: 0.2.0 +version: 0.3 synopsis: A time library, encoding, decoding, and instances description: Please see README.md homepage: https://github.com/andrewthad/chronos#readme @@ -22,15 +22,18 @@ , Chronos.Nanoseconds , Chronos.Day , Chronos.Date.Text + , Chronos.Date.ByteString.Char7 , Chronos.Datetime , Chronos.Datetime.Text + , Chronos.Datetime.ByteString.Char7 , Chronos.OffsetDatetime.Text + , Chronos.OffsetDatetime.ByteString.Char7 , Chronos.TimeOfDay.Text + , Chronos.TimeOfDay.ByteString.Char7 , Chronos.Internal , Chronos.Internal.Format , Chronos.Internal.Conversion , Chronos.Internal.CTimespec - , Chronos.Internal.FastText , Chronos.Tai , Chronos.Posix , Chronos.Month diff --git a/src/Chronos/Date/ByteString/Char7.hs b/src/Chronos/Date/ByteString/Char7.hs new file mode 100644 --- /dev/null +++ b/src/Chronos/Date/ByteString/Char7.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Chronos.Date.ByteString.Char7 where + +import Chronos.Types +import Data.ByteString (ByteString) +import Data.ByteString.Builder (Builder) +import Data.Vector (Vector) +import Data.Monoid +import Data.Attoparsec.ByteString.Char8 (Parser) +import Control.Monad +import Data.Foldable +import qualified Chronos.Internal.Format as Format +import qualified Chronos.Internal as I +import qualified Data.ByteString.Char8 as ByteString +import qualified Data.Attoparsec.ByteString.Char8 as Atto +import qualified Data.Vector as Vector +import qualified Data.ByteString.Builder as Builder + +-- | This could be written much more efficiently since we know the +-- exact size the resulting 'ByteString' will be. +builder_Ymd :: Maybe Char -> Date -> Builder +builder_Ymd msep (Date (Year y) m d) = case msep of + Nothing -> + Builder.intDec y + <> Format.monthToZeroPaddedDigitBS m + <> Format.zeroPadDayOfMonthBS d + Just sep -> let sepBuilder = Builder.char7 sep in + Builder.intDec y + <> sepBuilder + <> Format.monthToZeroPaddedDigitBS m + <> sepBuilder + <> Format.zeroPadDayOfMonthBS d + +parser_Ymd :: Maybe Char -> Parser Date +parser_Ymd msep = do + y <- I.parseFixedDigitsIntBS 4 + traverse_ Atto.char msep + m <- I.parseFixedDigitsIntBS 2 + when (m < 1 || m > 12) (fail "month must be between 1 and 12") + traverse_ Atto.char msep + d <- I.parseFixedDigitsIntBS 2 + when (d < 1 || d > 31) (fail "day must be between 1 and 31") + return (Date (Year y) (Month $ m - 1) (DayOfMonth d)) + + + diff --git a/src/Chronos/Datetime/ByteString/Char7.hs b/src/Chronos/Datetime/ByteString/Char7.hs new file mode 100644 --- /dev/null +++ b/src/Chronos/Datetime/ByteString/Char7.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Chronos.Datetime.ByteString.Char7 where + +import Chronos.Types +import Data.ByteString (ByteString) +import Data.ByteString.Builder (Builder) +import Data.Vector (Vector) +import Data.Monoid +import Data.Attoparsec.ByteString (Parser) +import Control.Monad +import Data.Foldable +import qualified Chronos.Date.ByteString.Char7 as Date +import qualified Chronos.TimeOfDay.ByteString.Char7 as TimeOfDay +import qualified Data.ByteString.Char8 as ByteString +import qualified Data.ByteString.Lazy.Char8 as LByteString +import qualified Data.Attoparsec.ByteString.Char8 as Atto +import qualified Data.Vector as Vector +import qualified Data.ByteString.Lazy.Builder as Builder + +encode_YmdHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> ByteString +encode_YmdHMS sp format = + LByteString.toStrict . Builder.toLazyByteString . builder_YmdHMS sp format + +encode_YmdIMS_p :: MeridiemLocale ByteString -> SubsecondPrecision -> DatetimeFormat -> Datetime -> ByteString +encode_YmdIMS_p a sp b = LByteString.toStrict . Builder.toLazyByteString . builder_YmdIMS_p a sp b + +-- | This could be written much more efficiently since we know the +-- exact size the resulting 'ByteString' will be. +builder_YmdHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder +builder_YmdHMS sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) = + case msep of + Nothing -> Date.builder_Ymd mdateSep date + <> TimeOfDay.builder_HMS sp mtimeSep time + Just sep -> Date.builder_Ymd mdateSep date + <> Builder.char7 sep + <> TimeOfDay.builder_HMS sp mtimeSep time + +builder_YmdIMS_p :: MeridiemLocale ByteString -> SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder +builder_YmdIMS_p locale sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) = + Date.builder_Ymd mdateSep date + <> maybe mempty Builder.char7 msep + <> TimeOfDay.builder_IMS_p locale sp mtimeSep time + +builder_YmdIMSp :: MeridiemLocale ByteString -> SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder +builder_YmdIMSp locale sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) = + Date.builder_Ymd mdateSep date + <> maybe mempty Builder.char7 msep + <> TimeOfDay.builder_IMS_p locale sp mtimeSep time + + +builderW3 :: Datetime -> Builder +builderW3 = builder_YmdHMS SubsecondPrecisionAuto (DatetimeFormat (Just '-') (Just 'T') (Just ':')) + +decode_YmdHMS :: DatetimeFormat -> ByteString -> Maybe Datetime +decode_YmdHMS format = + either (const Nothing) Just . Atto.parseOnly (parser_YmdHMS format) + +parser_YmdHMS :: DatetimeFormat -> Parser Datetime +parser_YmdHMS (DatetimeFormat mdateSep msep mtimeSep) = do + date <- Date.parser_Ymd mdateSep + traverse_ Atto.char msep + time <- TimeOfDay.parser_HMS mtimeSep + return (Datetime date time) + +parser_YmdHMS_opt_S :: DatetimeFormat -> Parser Datetime +parser_YmdHMS_opt_S (DatetimeFormat mdateSep msep mtimeSep) = do + date <- Date.parser_Ymd mdateSep + traverse_ Atto.char msep + time <- TimeOfDay.parser_HMS_opt_S mtimeSep + return (Datetime date time) + +decode_YmdHMS_opt_S :: DatetimeFormat -> ByteString -> Maybe Datetime +decode_YmdHMS_opt_S format = + either (const Nothing) Just . Atto.parseOnly (parser_YmdHMS_opt_S format) + + + + + diff --git a/src/Chronos/Datetime/Text.hs b/src/Chronos/Datetime/Text.hs --- a/src/Chronos/Datetime/Text.hs +++ b/src/Chronos/Datetime/Text.hs @@ -20,16 +20,16 @@ import qualified Data.Text.Lazy.Builder as Builder import qualified Data.Text.Lazy.Builder.Int as Builder -encode_YmdHMS :: SubsecondPrecision -> DatetimeFormat Char -> Datetime -> Text +encode_YmdHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> Text encode_YmdHMS sp format = LText.toStrict . Builder.toLazyText . builder_YmdHMS sp format -encode_YmdIMS_p :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat Char -> Datetime -> Text +encode_YmdIMS_p :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> Datetime -> Text encode_YmdIMS_p a sp b = LText.toStrict . Builder.toLazyText . builder_YmdIMS_p a sp b -- | This could be written much more efficiently since we know the -- exact size the resulting 'Text' will be. -builder_YmdHMS :: SubsecondPrecision -> DatetimeFormat Char -> Datetime -> Builder +builder_YmdHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder builder_YmdHMS sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) = case msep of Nothing -> Date.builder_Ymd mdateSep date @@ -38,13 +38,13 @@ <> Builder.singleton sep <> TimeOfDay.builder_HMS sp mtimeSep time -builder_YmdIMS_p :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat Char -> Datetime -> Builder +builder_YmdIMS_p :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder builder_YmdIMS_p locale sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) = Date.builder_Ymd mdateSep date <> maybe mempty Builder.singleton msep <> TimeOfDay.builder_IMS_p locale sp mtimeSep time -builder_YmdIMSp :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat Char -> Datetime -> Builder +builder_YmdIMSp :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> Datetime -> Builder builder_YmdIMSp locale sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) = Date.builder_Ymd mdateSep date <> maybe mempty Builder.singleton msep @@ -54,25 +54,25 @@ builderW3 :: Datetime -> Builder builderW3 = builder_YmdHMS SubsecondPrecisionAuto (DatetimeFormat (Just '-') (Just 'T') (Just ':')) -decode_YmdHMS :: DatetimeFormat Char -> Text -> Maybe Datetime +decode_YmdHMS :: DatetimeFormat -> Text -> Maybe Datetime decode_YmdHMS format = either (const Nothing) Just . Atto.parseOnly (parser_YmdHMS format) -parser_YmdHMS :: DatetimeFormat Char -> Parser Datetime +parser_YmdHMS :: DatetimeFormat -> Parser Datetime parser_YmdHMS (DatetimeFormat mdateSep msep mtimeSep) = do date <- Date.parser_Ymd mdateSep traverse_ Atto.char msep time <- TimeOfDay.parser_HMS mtimeSep return (Datetime date time) -parser_YmdHMS_opt_S :: DatetimeFormat Char -> Parser Datetime +parser_YmdHMS_opt_S :: DatetimeFormat -> Parser Datetime parser_YmdHMS_opt_S (DatetimeFormat mdateSep msep mtimeSep) = do date <- Date.parser_Ymd mdateSep traverse_ Atto.char msep time <- TimeOfDay.parser_HMS_opt_S mtimeSep return (Datetime date time) -decode_YmdHMS_opt_S :: DatetimeFormat Char -> Text -> Maybe Datetime +decode_YmdHMS_opt_S :: DatetimeFormat -> Text -> Maybe Datetime decode_YmdHMS_opt_S format = either (const Nothing) Just . Atto.parseOnly (parser_YmdHMS_opt_S format) diff --git a/src/Chronos/Day.hs b/src/Chronos/Day.hs --- a/src/Chronos/Day.hs +++ b/src/Chronos/Day.hs @@ -1,11 +1,33 @@ -module Chronos.Day where +module Chronos.Day + ( add + , diff + , today + , tomorrow + , yesterday + ) where import Chronos.Types import Data.Int +import Chronos.Internal.Conversion as Conv +import qualified Chronos.Posix as Posix +-- | Offset by the given number of days. To accomplish +-- subtraction, provide a negative number. add :: Int -> Day -> Day -add a (Day b) = Day (a + b) +add = Conv.addDay +-- | Take the difference between two days. diff :: Day -> Day -> Int -diff (Day a) (Day b) = a - b +diff = Conv.diffDay + +-- | Gets the current POSIX day. This does not take the user\'s +-- time zone into account. +today :: IO Day +today = fmap Posix.truncateToDay Posix.now + +tomorrow :: IO Day +tomorrow = fmap (add 1 . Posix.truncateToDay) Posix.now + +yesterday :: IO Day +yesterday = fmap (add (-1) . Posix.truncateToDay) Posix.now diff --git a/src/Chronos/Internal.hs b/src/Chronos/Internal.hs --- a/src/Chronos/Internal.hs +++ b/src/Chronos/Internal.hs @@ -9,6 +9,9 @@ import Data.Text.Lazy.Builder (Builder) import Data.Word import Data.Int +import qualified Data.ByteString.Builder as BBuilder +import qualified Data.ByteString.Char8 as BC8 +import qualified Data.Attoparsec.ByteString.Char8 as AB import qualified Data.Vector.Unboxed as UVector import qualified Data.Attoparsec.Text as Atto import qualified Data.Text.Lazy.Builder as Builder @@ -17,15 +20,26 @@ import qualified Data.Text as Text import qualified Data.Vector as Vector -parseFixedDigits :: Integral i => Int -> Parser i +parseFixedDigits :: Int -> Parser Int parseFixedDigits n = do t <- Atto.take n case Text.decimal t of Left err -> fail err Right (i,r) -> if Text.null r then return i - else fail "datetime decoding could not parse integral" + else fail "datetime decoding could not parse integral text" +{-# INLINE parseFixedDigits #-} +parseFixedDigitsIntBS :: Int -> AB.Parser Int +parseFixedDigitsIntBS n = do + t <- AB.take n + case BC8.readInt t of + Nothing -> fail "datetime decoding could not parse integral bytestring (a)" + Just (i,r) -> if BC8.null r + then return i + else fail "datetime decoding could not parse integral bytestring (b)" +{-# INLINE parseFixedDigitsIntBS #-} + raiseTenTo :: Int -> Int64 raiseTenTo i = if i > 15 then 10 ^ i @@ -35,14 +49,31 @@ tenRaisedToSmallPowers = UVector.fromList $ map (10 ^) [0 :: Int ..15] -- | Only provide positive numbers to this function. -indexTwoDigitTextBuilder :: Integral i => i -> Builder +indexTwoDigitTextBuilder :: Int -> Builder indexTwoDigitTextBuilder i = if i < 100 then Vector.unsafeIndex twoDigitTextBuilder (fromIntegral i) else Builder.decimal i {-# INLINE indexTwoDigitTextBuilder #-} +-- | Only provide positive numbers to this function. +indexTwoDigitByteStringBuilder :: Int -> BBuilder.Builder +indexTwoDigitByteStringBuilder i = if i < 100 + then Vector.unsafeIndex twoDigitByteStringBuilder (fromIntegral i) + else BBuilder.intDec i +{-# INLINE indexTwoDigitByteStringBuilder #-} + +twoDigitByteStringBuilder :: Vector BBuilder.Builder +twoDigitByteStringBuilder = Vector.fromList + $ map (BBuilder.byteString . BC8.pack) twoDigitStrings +{-# NOINLINE twoDigitByteStringBuilder #-} + twoDigitTextBuilder :: Vector Builder -twoDigitTextBuilder = Vector.fromList $ map Builder.fromText +twoDigitTextBuilder = Vector.fromList + $ map (Builder.fromText . Text.pack) twoDigitStrings +{-# NOINLINE twoDigitTextBuilder #-} + +twoDigitStrings :: [String] +twoDigitStrings = [ "00","01","02","03","04","05","06","07","08","09" , "10","11","12","13","14","15","16","17","18","19" , "20","21","22","23","24","25","26","27","28","29" @@ -54,7 +85,6 @@ , "80","81","82","83","84","85","86","87","88","89" , "90","91","92","93","94","95","96","97","98","99" ] -{-# NOINLINE twoDigitTextBuilder #-} countDigits :: (Integral a) => a -> Int {-# INLINE countDigits #-} diff --git a/src/Chronos/Internal/Conversion.hs b/src/Chronos/Internal/Conversion.hs --- a/src/Chronos/Internal/Conversion.hs +++ b/src/Chronos/Internal/Conversion.hs @@ -18,9 +18,9 @@ -- | The first argument in the resulting tuple in a day -- adjustment. It should be either -1, 0, or 1, as no -- offset should ever exceed 24 hours. -offsetTimeOfDay :: Offset -> TimeOfDay -> (Days, TimeOfDay) +offsetTimeOfDay :: Offset -> TimeOfDay -> (Int, TimeOfDay) offsetTimeOfDay (Offset offset) (TimeOfDay h m s) = - (Days dayAdjustment,TimeOfDay h'' m'' s) + (dayAdjustment,TimeOfDay h'' m'' s) where (!dayAdjustment, !h'') = divMod h' 24 (!hourAdjustment, !m'') = divMod m' 60 @@ -52,7 +52,7 @@ utcTimeToOffsetDatetime :: Offset -> UtcTime -> OffsetDatetime utcTimeToOffsetDatetime offset (UtcTime (Day d) nanoseconds) = - let (!(Days dayAdjustment),!tod) = offsetTimeOfDay offset (nanosecondsSinceMidnightToTimeOfDay nanoseconds) + let (!dayAdjustment,!tod) = offsetTimeOfDay offset (nanosecondsSinceMidnightToTimeOfDay nanoseconds) !date = dayToDate (Day (d + dayAdjustment)) in OffsetDatetime (Datetime date tod) offset @@ -68,8 +68,7 @@ offsetDatetimeToUtcTime :: OffsetDatetime -> UtcTime offsetDatetimeToUtcTime (OffsetDatetime (Datetime date timeOfDay) (Offset off)) = - let (!(Days !dayAdjustment),!tod) = - offsetTimeOfDay (Offset $ negate off) timeOfDay + let (!dayAdjustment,!tod) = offsetTimeOfDay (Offset $ negate off) timeOfDay !(Day !day) = dateToDay date in UtcTime (Day (day + dayAdjustment)) @@ -213,3 +212,12 @@ , replicate 31 (Month 11) ] {-# NOINLINE normalYearDayOfYearMonthTable #-} + +addDay :: Int -> Day -> Day +addDay a (Day b) = Day (a + b) +{-# INLINE addDay #-} + +diffDay :: Day -> Day -> Int +diffDay (Day a) (Day b) = a - b +{-# INLINE diffDay #-} + diff --git a/src/Chronos/Internal/FastText.hs b/src/Chronos/Internal/FastText.hs deleted file mode 100644 --- a/src/Chronos/Internal/FastText.hs +++ /dev/null @@ -1,40 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE RankNTypes #-} - -module Chronos.Internal.FastText where - -import Data.Text (Text) -import Control.Monad.ST (ST) -import qualified Data.Text.Internal as I -import qualified Data.Text as Text -import qualified Data.Text.Array as A -import qualified Data.Text.Internal.Unsafe.Char as C - -data MArrayAppend s = MArrayAppend (Int -> A.MArray s -> ST s Int) !Int - -combine :: MArrayAppend s -> MArrayAppend s -> MArrayAppend s -combine (MArrayAppend f maxSizeA) (MArrayAppend g maxSizeB) = do - MArrayAppend (\i marr -> f i marr >>= (\j -> g j marr)) (maxSizeA + maxSizeB) - -runMArrayAppend :: (forall s. MArrayAppend s) -> Text -runMArrayAppend x = - let (!arr, !word16Used) = A.run2 $ case x of - MArrayAppend f maxSize -> do - marr <- A.new maxSize - finalSize <- f 0 marr - return (marr,finalSize) - in I.Text arr 0 word16Used - -singleton :: Char -> MArrayAppend s -singleton c = MArrayAppend (\i marr -> do - C.unsafeWrite marr i c - ) 2 - -fromText :: Text -> MArrayAppend s -fromText (I.Text arr start len) = MArrayAppend (\i marr -> do - let j = len + i - A.copyI marr i arr start j - return j ) len - - - diff --git a/src/Chronos/Internal/Format.hs b/src/Chronos/Internal/Format.hs --- a/src/Chronos/Internal/Format.hs +++ b/src/Chronos/Internal/Format.hs @@ -8,6 +8,7 @@ import Data.Attoparsec.Text (Parser) import Control.Monad import Data.Foldable +import qualified Data.ByteString.Builder as BBuilder import qualified Chronos.Internal as I import qualified Data.Text as Text import qualified Data.Text.Read as Text @@ -22,4 +23,11 @@ zeroPadDayOfMonth :: DayOfMonth -> Builder zeroPadDayOfMonth (DayOfMonth d) = I.indexTwoDigitTextBuilder d + +monthToZeroPaddedDigitBS :: Month -> BBuilder.Builder +monthToZeroPaddedDigitBS (Month x) = + I.indexTwoDigitByteStringBuilder (x + 1) + +zeroPadDayOfMonthBS :: DayOfMonth -> BBuilder.Builder +zeroPadDayOfMonthBS (DayOfMonth d) = I.indexTwoDigitByteStringBuilder d diff --git a/src/Chronos/Locale/English/Text.hs b/src/Chronos/Locale/English/Text.hs --- a/src/Chronos/Locale/English/Text.hs +++ b/src/Chronos/Locale/English/Text.hs @@ -6,16 +6,16 @@ import qualified Chronos.Month as Month import Data.Text (Text) -datetimeW3 :: DatetimeFormat Char +datetimeW3 :: DatetimeFormat datetimeW3 = DatetimeFormat (Just '-') (Just 'T') (Just ':') -datetimeSlash :: DatetimeFormat Char +datetimeSlash :: DatetimeFormat datetimeSlash = DatetimeFormat (Just '/') (Just ' ') (Just ':') -datetimeHyphen :: DatetimeFormat Char +datetimeHyphen :: DatetimeFormat datetimeHyphen = DatetimeFormat (Just '-') (Just ' ') (Just ':') -datetimeCompact :: DatetimeFormat Char +datetimeCompact :: DatetimeFormat datetimeCompact = DatetimeFormat Nothing (Just 'T') Nothing meridiemLower :: MeridiemLocale Text diff --git a/src/Chronos/Nanoseconds.hs b/src/Chronos/Nanoseconds.hs --- a/src/Chronos/Nanoseconds.hs +++ b/src/Chronos/Nanoseconds.hs @@ -1,7 +1,13 @@ +{-| Functions that operate on 'Nanoseconds'. All of these functions have + trivial implementations and are provided for convenience. This module + is intended to be imported qualified. +-} + module Chronos.Nanoseconds ( -- * Arithmetic add , scale + , negate -- * From Duration -- $fromduration , fromSeconds diff --git a/src/Chronos/OffsetDatetime/ByteString/Char7.hs b/src/Chronos/OffsetDatetime/ByteString/Char7.hs new file mode 100644 --- /dev/null +++ b/src/Chronos/OffsetDatetime/ByteString/Char7.hs @@ -0,0 +1,169 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE BangPatterns #-} + +-- | The naming conventions for offsets that are used in +-- function names are as follows: +-- +-- * @%z@ - @z@ +hhmm numeric time zone (e.g., -0400) +-- * @%:z@ - @z1@ +hh:mm numeric time zone (e.g., -04:00) +-- * @%::z@ - @z2@ +hh:mm:ss numeric time zone (e.g., -04:00:00) +-- * @%:::z@ - @z3@ numeric time zone with : to necessary precision (e.g., -04, +05:30) + +module Chronos.OffsetDatetime.ByteString.Char7 where + +import Chronos.Types +import Data.ByteString (ByteString) +import Data.ByteString.Builder (Builder) +import Data.Vector (Vector) +import Data.Monoid +import Data.Attoparsec.ByteString (Parser) +import Control.Monad +import Data.Foldable +import Data.Int +import qualified Chronos.Internal as I +import qualified Chronos.Datetime.ByteString.Char7 as Datetime +import qualified Chronos.TimeOfDay.ByteString.Char7 as TimeOfDay +import qualified Data.ByteString.Char8 as ByteString +import qualified Data.Attoparsec.ByteString.Char8 as Atto +import qualified Data.Vector as Vector +import qualified Data.ByteString.Builder as Builder + +builder_YmdHMSz :: OffsetFormat -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> Builder +builder_YmdHMSz offsetFormat sp datetimeFormat (OffsetDatetime datetime offset) = + Datetime.builder_YmdHMS sp datetimeFormat datetime + <> offsetBuilder offsetFormat offset + +parser_YmdHMSz :: OffsetFormat -> DatetimeFormat -> Parser OffsetDatetime +parser_YmdHMSz offsetFormat datetimeFormat = OffsetDatetime + <$> Datetime.parser_YmdHMS datetimeFormat + <*> offsetParser offsetFormat + +builder_YmdIMS_p_z :: OffsetFormat -> MeridiemLocale ByteString -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> Builder +builder_YmdIMS_p_z offsetFormat meridiemLocale sp datetimeFormat (OffsetDatetime datetime offset) = + Datetime.builder_YmdIMS_p meridiemLocale sp datetimeFormat datetime + <> " " + <> offsetBuilder offsetFormat offset + +builderW3 :: OffsetDatetime -> Builder +builderW3 = builder_YmdHMSz + OffsetFormatColonOn + SubsecondPrecisionAuto + (DatetimeFormat (Just '-') (Just 'T') (Just ':')) + +offsetBuilder :: OffsetFormat -> Offset -> Builder +offsetBuilder x = case x of + OffsetFormatColonOff -> buildOffset_z + OffsetFormatColonOn -> buildOffset_z1 + OffsetFormatSecondsPrecision -> buildOffset_z2 + OffsetFormatColonAuto -> buildOffset_z3 + +offsetParser :: OffsetFormat -> Parser Offset +offsetParser x = case x of + OffsetFormatColonOff -> parseOffset_z + OffsetFormatColonOn -> parseOffset_z1 + OffsetFormatSecondsPrecision -> parseOffset_z2 + OffsetFormatColonAuto -> parseOffset_z3 + +-- | True means positive, false means negative +parseSignedness :: Parser Bool +parseSignedness = do + c <- Atto.anyChar + if c == '-' + then return False + else if c == '+' + then return True + else fail "while parsing offset, expected [+] or [-]" +{-# INLINE parseSignedness #-} + +parseOffset_z :: Parser Offset +parseOffset_z = do + pos <- parseSignedness + h <- I.parseFixedDigitsIntBS 2 + m <- I.parseFixedDigitsIntBS 2 + let !res = h * 60 + m + return . Offset $ if pos + then res + else negate res + +parseOffset_z1 :: Parser Offset +parseOffset_z1 = do + pos <- parseSignedness + h <- I.parseFixedDigitsIntBS 2 + _ <- Atto.char ':' + m <- I.parseFixedDigitsIntBS 2 + let !res = h * 60 + m + return . Offset $ if pos + then res + else negate res + +parseOffset_z2 :: Parser Offset +parseOffset_z2 = do + pos <- parseSignedness + h <- I.parseFixedDigitsIntBS 2 + _ <- Atto.char ':' + m <- I.parseFixedDigitsIntBS 2 + _ <- Atto.string ":00" + let !res = h * 60 + m + return . Offset $ if pos + then res + else negate res + +-- | This is generous in what it accepts. If you give +-- something like +04:00 as the offset, it will be +-- allowed, even though it could be shorter. +parseOffset_z3 :: Parser Offset +parseOffset_z3 = do + pos <- parseSignedness + h <- I.parseFixedDigitsIntBS 2 + mc <- Atto.peekChar + case mc of + Just ':' -> do + _ <- Atto.anyChar -- should be a colon + m <- I.parseFixedDigitsIntBS 2 + let !res = h * 60 + m + return . Offset $ if pos + then res + else negate res + _ -> return . Offset $ if pos + then h * 60 + else h * (-60) + +buildOffset_z :: Offset -> Builder +buildOffset_z (Offset i) = + let (!a,!b) = divMod (abs i) 60 + !prefix = if signum i == (-1) then "-" else "+" + in prefix + <> I.indexTwoDigitByteStringBuilder a + <> I.indexTwoDigitByteStringBuilder b + +buildOffset_z1 :: Offset -> Builder +buildOffset_z1 (Offset i) = + let (!a,!b) = divMod (abs i) 60 + !prefix = if signum i == (-1) then "-" else "+" + in prefix + <> I.indexTwoDigitByteStringBuilder a + <> ":" + <> I.indexTwoDigitByteStringBuilder b + +buildOffset_z2 :: Offset -> Builder +buildOffset_z2 (Offset i) = + let (!a,!b) = divMod (abs i) 60 + !prefix = if signum i == (-1) then "-" else "+" + in prefix + <> I.indexTwoDigitByteStringBuilder a + <> ":" + <> I.indexTwoDigitByteStringBuilder b + <> ":00" + +buildOffset_z3 :: Offset -> Builder +buildOffset_z3 (Offset i) = + let (!a,!b) = divMod (abs i) 60 + !prefix = if signum i == (-1) then "-" else "+" + in if b == 0 + then prefix + <> I.indexTwoDigitByteStringBuilder a + else prefix + <> I.indexTwoDigitByteStringBuilder a + <> ":" + <> I.indexTwoDigitByteStringBuilder b + diff --git a/src/Chronos/OffsetDatetime/Text.hs b/src/Chronos/OffsetDatetime/Text.hs --- a/src/Chronos/OffsetDatetime/Text.hs +++ b/src/Chronos/OffsetDatetime/Text.hs @@ -30,17 +30,17 @@ import qualified Data.Text.Lazy.Builder as Builder import qualified Data.Text.Lazy.Builder.Int as Builder -builder_YmdHMSz :: OffsetFormat -> SubsecondPrecision -> DatetimeFormat Char -> OffsetDatetime -> Builder +builder_YmdHMSz :: OffsetFormat -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> Builder builder_YmdHMSz offsetFormat sp datetimeFormat (OffsetDatetime datetime offset) = Datetime.builder_YmdHMS sp datetimeFormat datetime <> offsetBuilder offsetFormat offset -parser_YmdHMSz :: OffsetFormat -> DatetimeFormat Char -> Parser OffsetDatetime +parser_YmdHMSz :: OffsetFormat -> DatetimeFormat -> Parser OffsetDatetime parser_YmdHMSz offsetFormat datetimeFormat = OffsetDatetime <$> Datetime.parser_YmdHMS datetimeFormat <*> offsetParser offsetFormat -builder_YmdIMS_p_z :: OffsetFormat -> MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat Char -> OffsetDatetime -> Builder +builder_YmdIMS_p_z :: OffsetFormat -> MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> Builder builder_YmdIMS_p_z offsetFormat meridiemLocale sp datetimeFormat (OffsetDatetime datetime offset) = Datetime.builder_YmdIMS_p meridiemLocale sp datetimeFormat datetime <> " " diff --git a/src/Chronos/Posix.hs b/src/Chronos/Posix.hs --- a/src/Chronos/Posix.hs +++ b/src/Chronos/Posix.hs @@ -22,7 +22,6 @@ import Foreign.C.Types (CLong(..),CTime(..)) import Data.Word import Data.Int -import qualified Chronos.Day as Day import qualified Chronos.Nanoseconds as Nanoseconds epoch :: PosixTime @@ -49,11 +48,11 @@ -- first modified julian day. toUtc :: PosixTime -> UtcTime toUtc (PosixTime i) = let (d,t) = divMod i (getNanoseconds dayLength) - in UtcTime (Day.add (fromIntegral d) epochDay) (fromIntegral t) + in UtcTime (Conv.addDay (fromIntegral d) epochDay) (fromIntegral t) fromUtc :: UtcTime -> PosixTime fromUtc (UtcTime d ns') = PosixTime $ getNanoseconds $ Nanoseconds.add - (Nanoseconds.scale (fromIntegral (Day.diff d epochDay)) dayLength) + (Nanoseconds.scale (fromIntegral (Conv.diffDay d epochDay)) dayLength) (if ns > dayLength then dayLength else ns) where ns = Nanoseconds (fromIntegral ns') diff --git a/src/Chronos/TimeOfDay/ByteString/Char7.hs b/src/Chronos/TimeOfDay/ByteString/Char7.hs new file mode 100644 --- /dev/null +++ b/src/Chronos/TimeOfDay/ByteString/Char7.hs @@ -0,0 +1,206 @@ +{-| Functions for encoding 'TimeOfDay' to 'ByteString'. Any encoding + that is a superset of ASCII is compatible with the functions in + this module. This includes UTF-8 and ISO-8859-15 but does not + include UTF-16 or UTF-32. +-} + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE BangPatterns #-} + +module Chronos.TimeOfDay.ByteString.Char7 where + +import Chronos.Types +import Data.ByteString (ByteString) +import Data.ByteString.Builder (Builder) +import Data.Vector (Vector) +import Data.Monoid +import Data.Attoparsec.ByteString.Char8 (Parser) +import Control.Monad +import Control.Applicative +import Data.Foldable +import Data.Word +import Data.Int +import Data.Char (isDigit) +import qualified Data.ByteString.Char8 as ByteString +import qualified Chronos.Internal as I +import qualified Data.Text as Text +import qualified Data.Text.Read as Text +import qualified Data.Attoparsec.ByteString.Char8 as Atto +import qualified Data.Vector as Vector +import qualified Data.ByteString.Builder as Builder + +-- | This could be written much more efficiently since we know the +-- exact size the resulting 'Text' will be. +builder_HMS :: SubsecondPrecision -> Maybe Char -> TimeOfDay -> Builder +builder_HMS sp msep (TimeOfDay h m ns) = + I.indexTwoDigitByteStringBuilder h + <> internalBuilder_NS sp msep m ns + +builder_IMS_p :: MeridiemLocale ByteString -> SubsecondPrecision -> Maybe Char -> TimeOfDay -> Builder +builder_IMS_p meridiemLocale sp msep (TimeOfDay h m ns) = + internalBuilder_I h + <> internalBuilder_NS sp msep h ns + <> " " + <> internalBuilder_p meridiemLocale h + +internalBuilder_I :: Int -> Builder +internalBuilder_I h = + I.indexTwoDigitByteStringBuilder $ if h > 12 + then h - 12 + else if h == 0 + then 12 + else h + +internalBuilder_p :: MeridiemLocale ByteString -> Int -> Builder +internalBuilder_p (MeridiemLocale am pm) h = if h > 11 + then Builder.byteString pm + else Builder.byteString am + +builder_IMSp :: MeridiemLocale ByteString -> SubsecondPrecision -> Maybe Char -> TimeOfDay -> Builder +builder_IMSp meridiemLocale sp msep (TimeOfDay h m ns) = + internalBuilder_I h + <> internalBuilder_NS sp msep h ns + <> internalBuilder_p meridiemLocale h + +parser_HMS :: Maybe Char -> Parser TimeOfDay +parser_HMS msep = do + h <- I.parseFixedDigitsIntBS 2 + when (h > 23) (fail "hour must be between 0 and 23") + traverse_ Atto.char msep + m <- I.parseFixedDigitsIntBS 2 + when (m > 59) (fail "minute must be between 0 and 59") + traverse_ Atto.char msep + ns <- parseSecondsAndNanoseconds + return (TimeOfDay h m ns) + +-- | Parses text that is formatted as either of the following: +-- +-- * @%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 :: Maybe Char -> Parser TimeOfDay +parser_HMS_opt_S msep = do + h <- I.parseFixedDigitsIntBS 2 + when (h > 23) (fail "hour must be between 0 and 23") + traverse_ Atto.char msep + m <- I.parseFixedDigitsIntBS 2 + when (m > 59) (fail "minute must be between 0 and 59") + mc <- Atto.peekChar + case mc of + Nothing -> return (TimeOfDay h m 0) + Just c -> case msep of + Just sep -> if c == sep + then do + _ <- Atto.anyChar -- should be the separator + ns <- parseSecondsAndNanoseconds + return (TimeOfDay h m ns) + else return (TimeOfDay h m 0) + -- if there is no separator, we will try to parse the + -- remaining part as seconds. We commit to trying to + -- parse as seconds if we see any number as the next + -- character. + Nothing -> if isDigit c + then do + ns <- parseSecondsAndNanoseconds + return (TimeOfDay h m ns) + else return (TimeOfDay h m 0) + +parseSecondsAndNanoseconds :: Parser Int64 +parseSecondsAndNanoseconds = do + s' <- I.parseFixedDigitsIntBS 2 + let !s = fromIntegral s' :: Int64 + when (s > 60) (fail "seconds must be between 0 and 60") + let nanoseconds = 1 + nanoseconds <- + ( do _ <- Atto.char '.' + numberOfZeroes <- countZeroes + x <- Atto.decimal + let totalDigits = I.countDigits x + numberOfZeroes + result = if totalDigits == 9 + then x + else if totalDigits < 9 + then x * I.raiseTenTo (9 - totalDigits) + else quot x (I.raiseTenTo (totalDigits - 9)) + return (fromIntegral result) + ) <|> return 0 + return (s * 1000000000 + nanoseconds) + +countZeroes :: Parser Int +countZeroes = go 0 where + go !i = do + m <- Atto.peekChar + case m of + Nothing -> return i + Just c -> if c == '0' + then Atto.anyChar *> go (i + 1) + else return i + +nanosecondsBuilder :: Int64 -> Builder +nanosecondsBuilder w + | w == 0 = mempty + | w > 99999999 = "." <> int64Builder w + | w > 9999999 = ".0" <> int64Builder w + | w > 999999 = ".00" <> int64Builder w + | w > 99999 = ".000" <> int64Builder w + | w > 9999 = ".0000" <> int64Builder w + | w > 999 = ".00000" <> int64Builder w + | w > 99 = ".000000" <> int64Builder w + | w > 9 = ".0000000" <> int64Builder w + | otherwise = ".00000000" <> int64Builder w + +microsecondsBuilder :: Int64 -> Builder +microsecondsBuilder w + | w == 0 = mempty + | w > 99999 = "." <> int64Builder w + | w > 9999 = ".0" <> int64Builder w + | w > 999 = ".00" <> int64Builder w + | w > 99 = ".000" <> int64Builder w + | w > 9 = ".0000" <> int64Builder w + | otherwise = ".00000" <> int64Builder w + +millisecondsBuilder :: Int64 -> Builder +millisecondsBuilder w + | w == 0 = mempty + | w > 99 = "." <> int64Builder w + | w > 9 = ".0" <> int64Builder w + | otherwise = ".00" <> int64Builder w + +prettyNanosecondsBuilder :: SubsecondPrecision -> Int64 -> Builder +prettyNanosecondsBuilder sp nano = case sp of + SubsecondPrecisionAuto + | milliRem == 0 -> millisecondsBuilder milli + | microRem == 0 -> microsecondsBuilder micro + | otherwise -> nanosecondsBuilder nano + SubsecondPrecisionFixed d -> if d == 0 + then mempty + else + let newSubsecondPart = quot nano (I.raiseTenTo (9 - d)) + in "." + <> Builder.byteString (ByteString.replicate (d - I.countDigits newSubsecondPart) '0') + <> int64Builder newSubsecondPart + where + (milli,milliRem) = quotRem nano 1000000 + (micro,microRem) = quotRem nano 1000 + +int64Builder :: Int64 -> Builder +int64Builder = Builder.integerDec . fromIntegral + +internalBuilder_NS :: SubsecondPrecision -> Maybe Char -> Int -> Int64 -> Builder +internalBuilder_NS sp msep m ns = case msep of + Nothing -> I.indexTwoDigitByteStringBuilder m + <> I.indexTwoDigitByteStringBuilder s + <> prettyNanosecondsBuilder sp nsRemainder + Just sep -> let sepBuilder = Builder.char7 sep in + sepBuilder + <> I.indexTwoDigitByteStringBuilder m + <> sepBuilder + <> I.indexTwoDigitByteStringBuilder s + <> prettyNanosecondsBuilder sp nsRemainder + where + (!sInt64,!nsRemainder) = quotRem ns 1000000000 + !s = fromIntegral sInt64 + + diff --git a/src/Chronos/TimeOfDay/Text.hs b/src/Chronos/TimeOfDay/Text.hs --- a/src/Chronos/TimeOfDay/Text.hs +++ b/src/Chronos/TimeOfDay/Text.hs @@ -104,7 +104,8 @@ parseSecondsAndNanoseconds :: Parser Int64 parseSecondsAndNanoseconds = do - s <- I.parseFixedDigits 2 + s' <- I.parseFixedDigits 2 + let s = fromIntegral s' :: Int64 when (s > 60) (fail "seconds must be between 0 and 60") nanoseconds <- ( do _ <- Atto.char '.' diff --git a/src/Chronos/Types.hs b/src/Chronos/Types.hs --- a/src/Chronos/Types.hs +++ b/src/Chronos/Types.hs @@ -4,6 +4,8 @@ {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE DeriveGeneric #-} +{-# OPTIONS_GHC -Wall -Werror #-} + {- | Data types for representing different date and time-related information. @@ -33,10 +35,35 @@ -} -module Chronos.Types where +module Chronos.Types + ( Day(..) + , DayOfWeek(..) + , DayOfMonth(..) + , DayOfYear(..) + , Month(..) + , Year(..) + , Offset(..) + , TaiTime(..) + , PosixTime(..) + , UtcTime(..) + , DayOfWeekMatch(..) + , MonthMatch(..) + , UnboxedMonthMatch(..) + , Nanoseconds(..) + , SubsecondPrecision(..) + , Date(..) + , OrdinalDate(..) + , MonthDate(..) + , Datetime(..) + , OffsetDatetime(..) + , TimeOfDay(..) + , DatetimeFormat(..) + , OffsetFormat(..) + , DatetimeLocale(..) + , MeridiemLocale(..) + ) where import Data.Int -import Data.Word import Data.Vector (Vector) import Data.Aeson (FromJSON,ToJSON) import Data.Hashable (Hashable) @@ -47,35 +74,34 @@ import qualified Data.Vector.Unboxed as UVector import qualified Data.Vector.Primitive as PVector import qualified Data.Vector.Generic.Mutable as MGVector -import qualified Data.Vector.Unboxed.Mutable as MUVector -import qualified Data.Vector.Primitive.Mutable as MPVector +-- | A day represented as the modified Julian date, the number of days +-- since midnight on November 17, 1858. newtype Day = Day { getDay :: Int } - deriving (Show,Read,Eq,Ord,Hashable) - --- | A duration of days -newtype Days = Days { getDays :: Int } - deriving (Show,Read,Eq,Ord,Hashable) + deriving (Show,Read,Eq,Ord,Hashable,Enum) +-- | The day of the week. newtype DayOfWeek = DayOfWeek { getDayOfWeek :: Int } deriving (Show,Read,Eq,Ord,Hashable) +-- | The day of the month. newtype DayOfMonth = DayOfMonth { getDayOfMonth :: Int } deriving (Show,Read,Eq,Ord,Prim,Enum) +-- | The day of the year. newtype DayOfYear = DayOfYear { getDayOfYear :: Int } deriving (Show,Read,Eq,Ord,Prim) +-- | The month of the year. newtype Month = Month { getMonth :: Int } deriving (Show,Read,Eq,Ord,Prim) -newtype Months = Months { getMonths :: Int } - deriving (Show,Read,Eq,Ord) - instance Bounded Month where minBound = Month 0 maxBound = Month 11 +-- | The number of years elapsed since the beginning +-- of the Common Era. newtype Year = Year { getYear :: Int } deriving (Show,Read,Eq,Ord) @@ -93,18 +119,17 @@ newtype PosixTime = PosixTime { getPosixTime :: Int64 } deriving (FromJSON,ToJSON,Hashable,Eq,Ord,Show,Read) --- newtype Day = Day { getDay :: Word8 } --- newtype Week = Week { getWeek :: Word8 } - newtype DayOfWeekMatch a = DayOfWeekMatch { getDayOfWeekMatch :: Vector a } newtype MonthMatch a = MonthMatch { getMonthMatch :: Vector a } newtype UnboxedMonthMatch a = UnboxedMonthMatch { getUnboxedMonthMatch :: UVector.Vector a } +-- | A nanosecond duration. newtype Nanoseconds = Nanoseconds { getNanoseconds :: Int64 } - deriving (Show,Read,Eq,Ord) + deriving (Show,Read,Eq,Ord,ToJSON,FromJSON) +-- | The precision used when encoding seconds to a human-readable format. data SubsecondPrecision = SubsecondPrecisionAuto -- ^ Rounds to second, millisecond, microsecond, or nanosecond | SubsecondPrecisionFixed {-# UNPACK #-} !Int -- ^ Specify number of places after decimal @@ -116,14 +141,17 @@ , dateDay :: {-# UNPACK #-} !DayOfMonth } deriving (Show,Read,Eq,Ord) +-- | The year and number of days elapsed since the beginning it began. data OrdinalDate = OrdinalDate - { ordinalDateYear :: {-# UNPACK #-} !Year - , ordinalDateMonth :: {-# UNPACK #-} !DayOfYear + { ordinalDateYear :: {-# UNPACK #-} !Year + , ordinalDateDayOfYear :: {-# UNPACK #-} !DayOfYear } deriving (Show,Read,Eq,Ord) +-- | A month and the day of the month. This does not actually represent +-- a specific date, since this recurs every year. data MonthDate = MonthDate { monthDateMonth :: {-# UNPACK #-} !Month - , monthDateDay :: {-# UNPACK #-} !DayOfMonth + , monthDateDay :: {-# UNPACK #-} !DayOfMonth } deriving (Show,Read,Eq,Ord) -- | A date as represented by the Gregorian calendar @@ -138,7 +166,7 @@ , offsetDatetimeOffset :: {-# UNPACK #-} !Offset } deriving (Show,Read,Eq,Ord) --- | A time of day, including the possibility of leap seconds. +-- | A time of day with nanosecond resolution. data TimeOfDay = TimeOfDay { timeOfDayHour :: {-# UNPACK #-} !Int , timeOfDayMinute :: {-# UNPACK #-} !Int @@ -150,15 +178,16 @@ , utcTimeNanoseconds :: {-# UNPACK #-} !Int64 } deriving (Show,Read,Eq,Ord) -data DatetimeFormat a = DatetimeFormat - { datetimeFormatDateSeparator :: !(Maybe a) +data DatetimeFormat = DatetimeFormat + { datetimeFormatDateSeparator :: !(Maybe Char) -- ^ Separator in the date - , datetimeFormatSeparator :: !(Maybe a) + , datetimeFormatSeparator :: !(Maybe Char) -- ^ Separator between date and time - , datetimeFormatTimeSeparator :: !(Maybe a) + , datetimeFormatTimeSeparator :: !(Maybe Char) -- ^ Separator in the time } deriving (Show,Read,Eq,Ord) +-- | Formatting settings for a timezone offset. data OffsetFormat = OffsetFormatColonOff -- ^ @%z@ (e.g., -0400) | OffsetFormatColonOn -- ^ @%:z@ (e.g., -04:00) @@ -166,6 +195,9 @@ | OffsetFormatColonAuto -- ^ @%:::z@ (e.g., -04, +05:30) deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic) +-- | Locale-specific formatting for weekdays and months. The +-- type variable will likely be instantiated to @Text@ +-- or @ByteString@. data DatetimeLocale a = DatetimeLocale { datetimeLocaleDaysOfWeekFull :: !(DayOfWeekMatch a) -- ^ full weekdays starting with Sunday, 7 elements @@ -175,12 +207,9 @@ -- ^ full months starting with January, 12 elements , datetimeLocaleMonthsAbbreviated :: !(MonthMatch a) -- ^ abbreviated months starting with January, 12 elements - , datetimeLocaleAm :: !a - -- ^ Symbol for AM - , datetimeLocalePm :: !a - -- ^ Symbol for PM } +-- | Locale-specific formatting for AM and PM. data MeridiemLocale a = MeridiemLocale { meridiemLocaleAm :: !a , meridiemLocalePm :: !a diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -16,6 +16,7 @@ import Test.HUnit (Assertion,(@?=),assertBool) import Data.Text (Text) +import Data.ByteString (ByteString) import Data.Text.Lazy.Builder (Builder) import qualified Chronos.Internal.Conversion as Conv import qualified Chronos.Calendar as Month @@ -23,8 +24,12 @@ import qualified Data.Text as Text import qualified Data.Text.Lazy as LText import qualified Data.Text.Lazy.Builder as Builder +import qualified Data.ByteString.Builder as BBuilder +import qualified Data.ByteString.Lazy as LByteString import qualified Data.Attoparsec.Text as Atto +import qualified Data.Attoparsec.ByteString as AttoBS import qualified Chronos.TimeOfDay.Text as TimeOfDayText +import qualified Chronos.TimeOfDay.ByteString.Char7 as TimeOfDayByteString import qualified Chronos.Datetime.Text as DatetimeText import qualified Chronos.OffsetDatetime.Text as OffsetDatetimeText import qualified Chronos.Date.Text as DateText @@ -46,41 +51,80 @@ tests :: [Test] tests = [ testGroup "Time of Day" - [ testGroup "Parser Spec Tests" $ - [ testCase "No Separator + microseconds" - (timeOfDayParse Nothing "165956.246052" (TimeOfDay 16 59 56246052000)) - , testCase "Separator + microseconds" - (timeOfDayParse (Just ':') "16:59:56.246052" (TimeOfDay 16 59 56246052000)) - , testCase "Separator + milliseconds" - (timeOfDayParse (Just ':') "05:00:58.675" (TimeOfDay 05 00 58675000000)) - , testCase "Separator + deciseconds" - (timeOfDayParse (Just ':') "05:00:58.9" (TimeOfDay 05 00 58900000000)) - , testCase "Separator + no subseconds" - (timeOfDayParse (Just ':') "23:08:01" (TimeOfDay 23 8 1000000000)) - , testCase "Separator + nanoseconds" - (timeOfDayParse (Just ':') "05:00:58.111222999" (TimeOfDay 05 00 58111222999)) - , testCase "Separator + 10e-18 seconds (truncate)" - (timeOfDayParse (Just ':') "05:00:58.111222333444555666" (TimeOfDay 05 00 58111222333)) - , testCase "Separator + opt seconds (absent)" - (parseMatch (TimeOfDayText.parser_HMS_opt_S (Just ':')) "00:01" (TimeOfDay 0 1 0)) - , testCase "Separator + opt seconds (present)" - (parseMatch (TimeOfDayText.parser_HMS_opt_S (Just ':')) "00:01:05" (TimeOfDay 0 1 5000000000)) - , testCase "No Separator + opt seconds (absent)" - (parseMatch (TimeOfDayText.parser_HMS_opt_S Nothing) "0001" (TimeOfDay 0 1 0)) - , testCase "No Separator + opt seconds (present)" - (parseMatch (TimeOfDayText.parser_HMS_opt_S Nothing) "000105" (TimeOfDay 0 1 5000000000)) + [ testGroup "Text" + [ testGroup "Text Parsing Spec Tests" + [ testCase "No Separator + microseconds" + (timeOfDayParse Nothing "165956.246052" (TimeOfDay 16 59 56246052000)) + , testCase "Separator + microseconds" + (timeOfDayParse (Just ':') "16:59:56.246052" (TimeOfDay 16 59 56246052000)) + , testCase "Separator + milliseconds" + (timeOfDayParse (Just ':') "05:00:58.675" (TimeOfDay 05 00 58675000000)) + , testCase "Separator + deciseconds" + (timeOfDayParse (Just ':') "05:00:58.9" (TimeOfDay 05 00 58900000000)) + , testCase "Separator + no subseconds" + (timeOfDayParse (Just ':') "23:08:01" (TimeOfDay 23 8 1000000000)) + , testCase "Separator + nanoseconds" + (timeOfDayParse (Just ':') "05:00:58.111222999" (TimeOfDay 05 00 58111222999)) + , testCase "Separator + 10e-18 seconds (truncate)" + (timeOfDayParse (Just ':') "05:00:58.111222333444555666" (TimeOfDay 05 00 58111222333)) + , testCase "Separator + opt seconds (absent)" + (parseMatch (TimeOfDayText.parser_HMS_opt_S (Just ':')) "00:01" (TimeOfDay 0 1 0)) + , testCase "Separator + opt seconds (present)" + (parseMatch (TimeOfDayText.parser_HMS_opt_S (Just ':')) "00:01:05" (TimeOfDay 0 1 5000000000)) + , testCase "No Separator + opt seconds (absent)" + (parseMatch (TimeOfDayText.parser_HMS_opt_S Nothing) "0001" (TimeOfDay 0 1 0)) + , testCase "No Separator + opt seconds (present)" + (parseMatch (TimeOfDayText.parser_HMS_opt_S Nothing) "000105" (TimeOfDay 0 1 5000000000)) + ] + , testGroup "Text Builder Spec Tests" + [ testCase "No Separator + microseconds" + (timeOfDayBuilder (SubsecondPrecisionFixed 6) Nothing "165956.246052" (TimeOfDay 16 59 56246052000)) + , testCase "Separator + microseconds" + (timeOfDayBuilder (SubsecondPrecisionFixed 6) (Just ':') "16:59:56.246052" (TimeOfDay 16 59 56246052000)) + , testCase "Separator + no subseconds" + (timeOfDayBuilder (SubsecondPrecisionFixed 0) (Just ':') "23:08:01" (TimeOfDay 23 8 1000000000)) + ] + , testProperty "Text Builder Parser Isomorphism (H:M:S)" $ propEncodeDecodeIso + (LText.toStrict . Builder.toLazyText . TimeOfDayText.builder_HMS (SubsecondPrecisionFixed 9) (Just ':')) + (either (const Nothing) Just . Atto.parseOnly (TimeOfDayText.parser_HMS (Just ':'))) ] - , testGroup "Builder Spec Tests" - [ testCase "No Separator + microseconds" - (timeOfDayBuilder (SubsecondPrecisionFixed 6) Nothing "165956.246052" (TimeOfDay 16 59 56246052000)) - , testCase "Separator + microseconds" - (timeOfDayBuilder (SubsecondPrecisionFixed 6) (Just ':') "16:59:56.246052" (TimeOfDay 16 59 56246052000)) - , testCase "Separator + no subseconds" - (timeOfDayBuilder (SubsecondPrecisionFixed 0) (Just ':') "23:08:01" (TimeOfDay 23 8 1000000000)) + , testGroup "ByteString" + [ testGroup "Parser Spec Tests" + [ testCase "No Separator + microseconds" + (bsTimeOfDayParse Nothing "165956.246052" (TimeOfDay 16 59 56246052000)) + , testCase "Separator + microseconds" + (bsTimeOfDayParse (Just ':') "16:59:56.246052" (TimeOfDay 16 59 56246052000)) + , testCase "Separator + milliseconds" + (bsTimeOfDayParse (Just ':') "05:00:58.675" (TimeOfDay 05 00 58675000000)) + , testCase "Separator + deciseconds" + (bsTimeOfDayParse (Just ':') "05:00:58.9" (TimeOfDay 05 00 58900000000)) + , testCase "Separator + no subseconds" + (bsTimeOfDayParse (Just ':') "23:08:01" (TimeOfDay 23 8 1000000000)) + , testCase "Separator + nanoseconds" + (bsTimeOfDayParse (Just ':') "05:00:58.111222999" (TimeOfDay 05 00 58111222999)) + , testCase "Separator + 10e-18 seconds (truncate)" + (bsTimeOfDayParse (Just ':') "05:00:58.111222333444555666" (TimeOfDay 05 00 58111222333)) + , testCase "Separator + opt seconds (absent)" + (bsParseMatch (TimeOfDayByteString.parser_HMS_opt_S (Just ':')) "00:01" (TimeOfDay 0 1 0)) + , testCase "Separator + opt seconds (present)" + (bsParseMatch (TimeOfDayByteString.parser_HMS_opt_S (Just ':')) "00:01:05" (TimeOfDay 0 1 5000000000)) + , testCase "No Separator + opt seconds (absent)" + (bsParseMatch (TimeOfDayByteString.parser_HMS_opt_S Nothing) "0001" (TimeOfDay 0 1 0)) + , testCase "No Separator + opt seconds (present)" + (bsParseMatch (TimeOfDayByteString.parser_HMS_opt_S Nothing) "000105" (TimeOfDay 0 1 5000000000)) + ] + , testGroup "Builder Spec Tests" + [ testCase "No Separator + microseconds" + (bsTimeOfDayBuilder (SubsecondPrecisionFixed 6) Nothing "165956.246052" (TimeOfDay 16 59 56246052000)) + , testCase "Separator + microseconds" + (bsTimeOfDayBuilder (SubsecondPrecisionFixed 6) (Just ':') "16:59:56.246052" (TimeOfDay 16 59 56246052000)) + , testCase "Separator + no subseconds" + (bsTimeOfDayBuilder (SubsecondPrecisionFixed 0) (Just ':') "23:08:01" (TimeOfDay 23 8 1000000000)) + ] + , testProperty "Builder Parser Isomorphism (H:M:S)" $ propEncodeDecodeIso + (LByteString.toStrict . BBuilder.toLazyByteString . TimeOfDayByteString.builder_HMS (SubsecondPrecisionFixed 9) (Just ':')) + (either (const Nothing) Just . AttoBS.parseOnly (TimeOfDayByteString.parser_HMS (Just ':'))) ] - , testProperty "Builder Parser Isomorphism (H:M:S)" $ propEncodeDecodeIso - (LText.toStrict . Builder.toLazyText . TimeOfDayText.builder_HMS (SubsecondPrecisionFixed 9) (Just ':')) - (either (const Nothing) Just . Atto.parseOnly (TimeOfDayText.parser_HMS (Just ':'))) ] , testGroup "Date" [ testGroup "Parser Spec Tests" $ @@ -198,16 +242,32 @@ Atto.parseOnly (p <* Atto.endOfInput) t @?= Right expected +bsParseMatch :: (Eq a, Show a) => AttoBS.Parser a -> ByteString -> a -> Assertion +bsParseMatch p t expected = do + AttoBS.parseOnly (p <* AttoBS.endOfInput) t + @?= Right expected + timeOfDayParse :: Maybe Char -> Text -> TimeOfDay -> Assertion timeOfDayParse m t expected = Atto.parseOnly (TimeOfDayText.parser_HMS m <* Atto.endOfInput) t @?= Right expected +bsTimeOfDayParse :: Maybe Char -> ByteString -> TimeOfDay -> Assertion +bsTimeOfDayParse m t expected = + AttoBS.parseOnly (TimeOfDayByteString.parser_HMS m <* AttoBS.endOfInput) t + @?= Right expected + + timeOfDayBuilder :: SubsecondPrecision -> Maybe Char -> Text -> TimeOfDay -> Assertion timeOfDayBuilder sp m expected tod = LText.toStrict (Builder.toLazyText (TimeOfDayText.builder_HMS sp m tod)) @?= expected +bsTimeOfDayBuilder :: SubsecondPrecision -> Maybe Char -> Text -> TimeOfDay -> Assertion +bsTimeOfDayBuilder sp m expected tod = + LText.toStrict (Builder.toLazyText (TimeOfDayText.builder_HMS sp m tod)) + @?= expected + dateParse :: Maybe Char -> Text -> Date -> Assertion dateParse m t expected = Atto.parseOnly (DateText.parser_Ymd m <* Atto.endOfInput) t @@ -247,7 +307,7 @@ <$> arbitrary <*> arbitrary -instance (Arbitrary a, a ~ Char) => Arbitrary (DatetimeFormat a) where +instance Arbitrary DatetimeFormat where arbitrary = DatetimeFormat <$> arbitrary <*> elements [Nothing, Just '/', Just ':', Just '-']