diff --git a/bench/Bench.hs b/bench/Bench.hs --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -110,18 +110,3 @@ ] ] ] - -instance NFData Chronos.Datetime where - rnf (Chronos.Datetime a b) = a `deepseq` b `deepseq` () - -instance NFData Chronos.Date where - rnf (Chronos.Date y m d) = y `deepseq` m `deepseq` d `deepseq` () - -instance NFData Chronos.TimeOfDay where - rnf (Chronos.TimeOfDay h m s) = h `deepseq` m `deepseq` s `deepseq` () - -deriving instance NFData Chronos.DayOfMonth -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 @@ -1,10 +1,10 @@ -cabal-version: 2.2 +cabal-version: 3.0 name: chronos version: - 1.1.1 + 1.1.2 synopsis: - A performant time library + A high-performance time library description: Chronos is a performance-oriented time library for Haskell, with a straightforward API. The main differences between this @@ -61,6 +61,7 @@ , attoparsec >= 0.13 && < 0.14 , base >= 4.9 && < 5 , bytestring >= 0.10 && < 0.11 + , deepseq >= 1.4.4.0 , hashable >= 1.2 && < 1.4 , primitive >= 0.6.4 && < 0.8 , semigroups >= 0.16 && < 0.20 @@ -89,10 +90,12 @@ build-depends: , HUnit , QuickCheck + , aeson >= 1.1 && < 1.5 , attoparsec , base , bytestring , chronos + , deepseq >= 1.4.4.0 , test-framework , test-framework-hunit , test-framework-quickcheck2 @@ -115,7 +118,9 @@ , QuickCheck , base , chronos + , deepseq >= 1.4.4.0 , doctest >= 0.10 + , torsor >= 0.1 && < 0.2 default-language: Haskell2010 @@ -134,6 +139,7 @@ , chronos , criterion , deepseq + , deepseq >= 1.4.4.0 , old-locale , text , thyme diff --git a/src/Chronos.hs b/src/Chronos.hs --- a/src/Chronos.hs +++ b/src/Chronos.hs @@ -155,6 +155,8 @@ , builder_YmdIMSp , builder_YmdIMS_p , builderW3C + , builderIso8601 + , encodeIso8601 , encode_DmyHMS , encode_DmyIMS_p , encode_YmdHMS @@ -270,6 +272,7 @@ ) where import Control.Applicative +import Control.DeepSeq (NFData(..), deepseq) import Control.Exception (evaluate) import Control.Monad import Data.Aeson (FromJSON,ToJSON,FromJSONKey,ToJSONKey) @@ -473,7 +476,7 @@ where mx = if m >= 1 && m <= 12 then fromIntegral (m - 1) - else 1 + else 0 -- | Construct a 'Time' from year, month, day, hour, minute, second: -- @@ -509,7 +512,7 @@ SYSTEMTIME{..} <- W32.getSystemTime let date = Date { dateYear = Year (fromIntegral wYear) - , dateMonth = Month (fromIntegral wMonth) + , dateMonth = Month (fromIntegral wMonth - 1) , dateDay = DayOfMonth (fromIntegral wDay) } let secNano = (fromIntegral wSecond :: Int64) * 1000000000 @@ -953,13 +956,13 @@ -- | Given a 'Date' and a separator, construct a 'Text' 'TB.Builder' -- corresponding to Year\/Month\/Day encoding. builder_Ymd :: Maybe Char -> Date -> TB.Builder -builder_Ymd msep (Date (Year y) m d) = case msep of +builder_Ymd msep (Date y m d) = case msep of Nothing -> - TB.decimal y + yearToZeroPaddedDigit y <> monthToZeroPaddedDigit m <> zeroPadDayOfMonth d Just sep -> let sepBuilder = TB.singleton sep in - TB.decimal y + yearToZeroPaddedDigit y <> sepBuilder <> monthToZeroPaddedDigit m <> sepBuilder @@ -968,17 +971,17 @@ -- | Given a 'Date' and a separator, construct a 'Text' 'TB.Builder' -- corresponding to a Day\/Month\/Year encoding. builder_Dmy :: Maybe Char -> Date -> TB.Builder -builder_Dmy msep (Date (Year y) m d) = case msep of +builder_Dmy msep (Date y m d) = case msep of Nothing -> zeroPadDayOfMonth d <> monthToZeroPaddedDigit m - <> TB.decimal y + <> yearToZeroPaddedDigit y Just sep -> let sepBuilder = TB.singleton sep in zeroPadDayOfMonth d <> sepBuilder <> monthToZeroPaddedDigit m <> sepBuilder - <> TB.decimal y + <> yearToZeroPaddedDigit y -- | Parse a Year\/Month\/Day-encoded 'Date' that uses the -- given separator. @@ -1070,13 +1073,13 @@ -- | 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 -builderUtf8_Ymd msep (Date (Year y) m d) = case msep of +builderUtf8_Ymd msep (Date y m d) = case msep of Nothing -> - BB.intDec y + yearToZeroPaddedDigitBS y <> monthToZeroPaddedDigitBS m <> zeroPadDayOfMonthBS d Just sep -> let sepBuilder = BB.char7 sep in - BB.intDec y + yearToZeroPaddedDigitBS y <> sepBuilder <> monthToZeroPaddedDigitBS m <> sepBuilder @@ -1427,9 +1430,21 @@ -- | Construct a 'Text' 'TB.Builder' corresponding to the W3C -- encoding of the given 'Datetime'. +-- +-- Deprecated. This is just a poorly named alias for 'builderIso8601'. builderW3C :: Datetime -> TB.Builder -builderW3C = builder_YmdHMS SubsecondPrecisionAuto w3c +builderW3C = builderIso8601 +-- | Construct a 'Text' 'TB.Builder' corresponding to the ISO-8601 +-- encoding of the given 'Datetime'. +builderIso8601 :: Datetime -> TB.Builder +builderIso8601 = builder_YmdHMS SubsecondPrecisionAuto w3c + +-- | Construct 'Text' corresponding to the ISO-8601 +-- encoding of the given 'Datetime'. +encodeIso8601 :: Datetime -> Text +encodeIso8601 = LT.toStrict . TB.toLazyText . builderIso8601 + -- | Decode a Year\/Month\/Day,Hour\/Minute\/Second-encoded 'Datetime' -- from 'Text' that was encoded with the given 'DatetimeFormat'. decode_YmdHMS :: DatetimeFormat -> Text -> Maybe Datetime @@ -2649,6 +2664,13 @@ tenRaisedToSmallPowers :: UVector.Vector Int64 tenRaisedToSmallPowers = UVector.fromList $ map (10 ^) [0 :: Int ..15] +yearToZeroPaddedDigit :: Year -> TB.Builder +yearToZeroPaddedDigit (Year x) + | x < 10 = "000" <> TB.decimal x + | x < 100 = "00" <> TB.decimal x + | x < 1000 = "0" <> TB.decimal x + | otherwise = TB.decimal x + monthToZeroPaddedDigit :: Month -> TB.Builder monthToZeroPaddedDigit (Month x) = indexTwoDigitTextBuilder (x + 1) @@ -2656,6 +2678,13 @@ zeroPadDayOfMonth :: DayOfMonth -> TB.Builder zeroPadDayOfMonth (DayOfMonth d) = indexTwoDigitTextBuilder d +yearToZeroPaddedDigitBS :: Year -> BB.Builder +yearToZeroPaddedDigitBS (Year x) + | x < 10 = "000" <> BB.intDec x + | x < 100 = "00" <> BB.intDec x + | x < 1000 = "0" <> BB.intDec x + | otherwise = BB.intDec x + monthToZeroPaddedDigitBS :: Month -> BB.Builder monthToZeroPaddedDigitBS (Month x) = indexTwoDigitByteStringBuilder (x + 1) @@ -2710,26 +2739,27 @@ -- | 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,Enum,ToJSON,FromJSON,Storable,Prim) + deriving (Show,Read,Eq,Ord,Hashable,Enum,ToJSON,FromJSON,Storable,Prim,NFData) + instance Torsor Day Int where add i (Day d) = Day (d + i) difference (Day a) (Day b) = a - b -- | The day of the week. newtype DayOfWeek = DayOfWeek { getDayOfWeek :: Int } - deriving (Show,Read,Eq,Ord,Hashable) + deriving (Show,Read,Eq,Ord,Hashable,NFData) -- | The day of the month. newtype DayOfMonth = DayOfMonth { getDayOfMonth :: Int } - deriving (Show,Read,Eq,Ord,Prim,Enum) + deriving (Show,Read,Eq,Ord,Prim,Enum,NFData) -- | The day of the year. newtype DayOfYear = DayOfYear { getDayOfYear :: Int } - deriving (Show,Read,Eq,Ord,Prim) + deriving (Show,Read,Eq,Ord,Prim,NFData) -- | The month of the year. newtype Month = Month { getMonth :: Int } - deriving (Show,Read,Eq,Ord,Prim) + deriving (Show,Read,Eq,Ord,Prim,NFData) instance Enum Month where fromEnum = getMonth @@ -2750,36 +2780,39 @@ -- | The number of years elapsed since the beginning -- of the Common Era. newtype Year = Year { getYear :: Int } - deriving (Show,Read,Eq,Ord) + deriving (Show,Read,Eq,Ord, NFData) -- | A . newtype Offset = Offset { getOffset :: Int } - deriving (Show,Read,Eq,Ord,Enum) + deriving (Show,Read,Eq,Ord,Enum,NFData) -- | POSIX time with nanosecond resolution. newtype Time = Time { getTime :: Int64 } - deriving (FromJSON,ToJSON,Hashable,Eq,Ord,Show,Read,Storable,Prim,Bounded) + deriving (FromJSON,ToJSON,Hashable,Eq,Ord,Show,Read,Storable,Prim,Bounded, NFData) -- | Match a 'DayOfWeek'. By `match`, we mean that a 'DayOfWeekMatch' -- is a mapping from the integer value of a 'DayOfWeek' to some value -- of type @a@. You should construct a 'DayOfWeekMatch' with -- 'buildDayOfWeekMatch', and match it using 'caseDayOfWeek'. newtype DayOfWeekMatch a = DayOfWeekMatch { getDayOfWeekMatch :: Vector a } + deriving (NFData) -- | Match a 'Month'. By `match`, we mean that a 'MonthMatch' is -- a mapping from the integer value of a 'Month' to some value of -- type @a@. You should construct a 'MonthMatch' with -- 'buildMonthMatch', and match it using 'caseMonth'. newtype MonthMatch a = MonthMatch { getMonthMatch :: Vector a } + deriving (NFData) -- | Like 'MonthMatch', but the matched value can have an instance of -- 'UVector.Unbox'. newtype UnboxedMonthMatch a = UnboxedMonthMatch { getUnboxedMonthMatch :: UVector.Vector a } + deriving (NFData) -- | A timespan. This is represented internally as a number -- of nanoseconds. newtype Timespan = Timespan { getTimespan :: Int64 } - deriving (Show,Read,Eq,Ord,ToJSON,FromJSON,Additive) + deriving (Show,Read,Eq,Ord,ToJSON,FromJSON,Additive,NFData) instance Semigroup Timespan where (Timespan a) <> (Timespan b) = Timespan (a + b) @@ -2805,6 +2838,11 @@ | SubsecondPrecisionFixed {-# UNPACK #-} !Int -- ^ Specify number of places after decimal deriving (Eq, Ord, Show, Read) +instance NFData SubsecondPrecision where + rnf (SubsecondPrecisionAuto) = () + rnf (SubsecondPrecisionFixed a) = a `deepseq` () + + -- | A date as represented by the Gregorian calendar. data Date = Date { dateYear :: {-# UNPACK #-} !Year @@ -2812,6 +2850,9 @@ , dateDay :: {-# UNPACK #-} !DayOfMonth } deriving (Show,Read,Eq,Ord) +instance NFData Date where + rnf (Date y m d) = y `deepseq` m `deepseq` d `deepseq` () + -- | An 'OrdinalDate' is a 'Year' and the number of days elapsed -- since the 'Year' began. data OrdinalDate = OrdinalDate @@ -2819,6 +2860,9 @@ , ordinalDateDayOfYear :: {-# UNPACK #-} !DayOfYear } deriving (Show,Read,Eq,Ord) +instance NFData OrdinalDate where + rnf (OrdinalDate y d) = y `deepseq` d `deepseq` () + -- | A month and the day of the month. This does not actually represent -- a specific date, since this recurs every year. data MonthDate = MonthDate @@ -2826,19 +2870,31 @@ , monthDateDay :: {-# UNPACK #-} !DayOfMonth } deriving (Show,Read,Eq,Ord) +instance NFData MonthDate where + rnf (MonthDate m d) = m `deepseq` d `deepseq` () + -- | A 'Date' as represented by the Gregorian calendar -- and a 'TimeOfDay'. +-- While the 'ToJSON' instance encodes with a hyphen separator, the +-- 'FromJSON' instance allows any non-digit character to act as +-- separator, using the lenient parser. data Datetime = Datetime { datetimeDate :: {-# UNPACK #-} !Date , datetimeTime :: {-# UNPACK #-} !TimeOfDay } deriving (Show,Read,Eq,Ord) +instance NFData Datetime where + rnf (Datetime d t) = d `deepseq` t `deepseq` () + -- | A 'Datetime' with a time zone 'Offset'. data OffsetDatetime = OffsetDatetime { offsetDatetimeDatetime :: {-# UNPACK #-} !Datetime , offsetDatetimeOffset :: {-# UNPACK #-} !Offset } deriving (Show,Read,Eq,Ord) +instance NFData OffsetDatetime where + rnf (OffsetDatetime dt o) = dt `deepseq` o `deepseq` () + -- | A time of day with nanosecond resolution. data TimeOfDay = TimeOfDay { timeOfDayHour :: {-# UNPACK #-} !Int @@ -2846,6 +2902,9 @@ , timeOfDayNanoseconds :: {-# UNPACK #-} !Int64 } deriving (Show,Read,Eq,Ord) +instance NFData TimeOfDay where + rnf (TimeOfDay h m s) = h `deepseq` m `deepseq` s `deepseq` () + -- | The format of a 'Datetime'. In particular -- this provides separators for parts of the 'Datetime' -- and nothing else. @@ -2858,6 +2917,9 @@ -- ^ Separator in the time } deriving (Show,Read,Eq,Ord) +instance NFData DatetimeFormat where + rnf (DatetimeFormat s1 s2 s3) = s1 `deepseq` s2 `deepseq` s3 `deepseq` () + -- | Formatting settings for a timezone offset. data OffsetFormat = OffsetFormatColonOff -- ^ @%z@ (e.g., -0400) @@ -2866,6 +2928,9 @@ | OffsetFormatColonAuto -- ^ @%:::z@ (e.g., -04, +05:30) deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic) +instance NFData OffsetFormat where + rnf !_ = () + -- | Locale-specific formatting for weekdays and months. The -- type variable will likely be instantiated to @Text@ -- or @ByteString@. @@ -2880,6 +2945,10 @@ -- ^ abbreviated months starting with January, 12 elements } +instance NFData a => NFData (DatetimeLocale a) where + rnf (DatetimeLocale d1 d2 m1 m2) = + d1 `deepseq` d2 `deepseq` m1 `deepseq` m2 `deepseq` () + -- | A TimeInterval represents a start and end time. -- It can sometimes be more ergonomic than the 'Torsor' API when -- you only care about whether or not a 'Time' is within a certain range. @@ -2890,12 +2959,18 @@ data TimeInterval = TimeInterval {-# UNPACK #-} !Time {-# UNPACK #-} !Time deriving (Read,Show,Eq,Ord,Bounded) +instance NFData TimeInterval where + rnf (TimeInterval t1 t2) = t1 `deepseq` t2 `deepseq` () + -- | Locale-specific formatting for AM and PM. data MeridiemLocale a = MeridiemLocale { meridiemLocaleAm :: !a , meridiemLocalePm :: !a } deriving (Read,Show,Eq,Ord) +instance NFData a => NFData (MeridiemLocale a) where + rnf (MeridiemLocale am pm) = am `deepseq` pm `deepseq` () + newtype instance UVector.MVector s Month = MV_Month (PVector.MVector s Month) newtype instance UVector.Vector Month = V_Month (PVector.Vector Month) @@ -3045,6 +3120,14 @@ toJSON = AE.String . encode_YmdHMS SubsecondPrecisionAuto hyphen toEncoding x = AEE.unsafeToEncoding (BB.char7 '"' SG.<> builderUtf8_YmdHMS SubsecondPrecisionAuto hyphen x SG.<> BB.char7 '"') +instance FromJSON Datetime where + parseJSON = + AE.withText "Datetime" aesonParserDatetime + +aesonParserDatetime :: Text -> AET.Parser Datetime +aesonParserDatetime = + either (const (fail "could not parse Datetime")) pure . AT.parseOnly (parser_lenient <* AT.endOfInput) + instance ToJSON Offset where toJSON = AE.String . encodeOffset OffsetFormatColonOn toEncoding x = AEE.unsafeToEncoding (BB.char7 '"' SG.<> builderOffsetUtf8 OffsetFormatColonOn x SG.<> BB.char7 '"') @@ -3079,6 +3162,10 @@ , timePartsOffset :: !Int } deriving (Eq, Read, Show) + +instance NFData TimeParts where + rnf (TimeParts d mo y h m s ss o) = + d `deepseq` mo `deepseq` y `deepseq` h `deepseq` m `deepseq` s `deepseq` ss `deepseq` o `deepseq` () -- | Deconstruct a 'Time' into its 'TimeParts'. timeParts :: Offset -> Time -> TimeParts 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 @@ -7,7 +7,9 @@ ( #ifndef mingw32_HOST_OS getPosixNanoseconds +#ifndef ghcjs_HOST_OS , CTimespec(..) +#endif #endif ) where diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -6,6 +6,7 @@ module Main (main) where import Chronos.Types +import qualified Data.Aeson as AE import Data.ByteString (ByteString) import Data.Int (Int64) import Data.List (intercalate) @@ -169,6 +170,8 @@ (dateBuilder (Just '-') "2016-01-01" (Date (Year 2016) (Month 0) (DayOfMonth 1))) , PH.testCase "Separator 2" (dateBuilder (Just '-') "1876-09-27" (Date (Year 1876) (Month 8) (DayOfMonth 27))) + , PH.testCase "zero-pad year" + (dateBuilder (Just '-') "0001-01-01" (Date (Year 1) (Month 0) (DayOfMonth 1))) ] , testProperty "Builder Parser Isomorphism (Y-m-d)" $ propEncodeDecodeIso (LText.toStrict . Builder.toLazyText . C.builder_Ymd (Just '-')) @@ -479,6 +482,11 @@ (C.timeToDayOfWeek (Time (-17308800000000000)) @?= DayOfWeek 6) , PH.testCase "Tuesday, June 6, 1944 4:00:00 PM" (C.timeToDayOfWeek (Time (-806918400000000000)) @?= DayOfWeek 2) + ] + , testGroup "json" + [ PH.testCase "Datetime" $ + let dt = Datetime (Date (Year 3000) (Month 11) (DayOfMonth 31)) (TimeOfDay 0 0 0) + in AE.eitherDecode (AE.encode dt) @?= Right dt ] ]