diff --git a/chronos.cabal b/chronos.cabal --- a/chronos.cabal +++ b/chronos.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: chronos -version: 1.1.3 +version: 1.1.4 synopsis: A high-performance time library description: Chronos is a performance-oriented time library for Haskell, with a @@ -46,10 +46,10 @@ -- it is OPTIONS_HADDOCK-hidden Chronos.Internal.CTimespec build-depends: - , aeson >= 1.1 && < 1.6 + , aeson >= 1.1 && < 2.1 , attoparsec >= 0.13 && < 0.15 - , base >= 4.12 && < 5 - , bytestring >= 0.10 && < 0.11 + , base >= 4.14 && < 4.16 + , bytestring >= 0.10 && < 0.12 , deepseq >= 1.4.4.0 , hashable >= 1.2 && < 1.4 , primitive >= 0.6.4 && < 0.8 @@ -63,7 +63,7 @@ , text-short >= 0.1.3 && <0.2 , natural-arithmetic >= 0.1.2 && <0.2 if os(windows) - build-depends: Win32 >= 2.2 && < 2.9 + build-depends: Win32 >= 2.2 && < 2.14 default-language: Haskell2010 c-sources: src/cbits/hs-time.c ghc-options: @@ -91,19 +91,6 @@ ghc-options: -threaded -rtsopts -with-rtsopts=-N - default-language: Haskell2010 - -test-suite doctest - type: exitcode-stdio-1.0 - hs-source-dirs: test - main-is: Doctests.hs - build-depends: - , QuickCheck - , base - , chronos - , deepseq >= 1.4.4.0 - , doctest >= 0.10 - , torsor >= 0.1 && < 0.2 default-language: Haskell2010 benchmark bench diff --git a/src/Chronos.hs b/src/Chronos.hs --- a/src/Chronos.hs +++ b/src/Chronos.hs @@ -1,19 +1,17 @@ -{-# language - BangPatterns - , CPP - , DeriveGeneric - , GeneralizedNewtypeDeriving - , LambdaCase - , MultiParamTypeClasses - , NumericUnderscores - , OverloadedStrings - , RecordWildCards - , ScopedTypeVariables - , TypeApplications - , TypeFamilies - , TypeInType - , UnboxedTuples - #-} +{-# language BangPatterns #-} +{-# language CPP #-} +{-# language DeriveGeneric #-} +{-# language GeneralizedNewtypeDeriving #-} +{-# language LambdaCase #-} +{-# language MultiParamTypeClasses #-} +{-# language NumericUnderscores #-} +{-# language OverloadedStrings #-} +{-# language RecordWildCards #-} +{-# language ScopedTypeVariables #-} +{-# language TypeApplications #-} +{-# language TypeFamilies #-} +{-# language TypeInType #-} +{-# language UnboxedTuples #-} {-| Chronos is a performance-oriented time library for Haskell, with a straightforward API. The main differences between this @@ -61,6 +59,7 @@ , timeToDatetime , datetimeToTime , datetimeToDayOfWeek + , dateToDayOfWeek , timeToOffsetDatetime , offsetDatetimeToTime , timeToDayTruncate @@ -155,6 +154,8 @@ , builderW3C , builderIso8601 , encodeIso8601 + , encode_Ymd + , encode_Dmy , encode_DmyHMS , encode_DmyIMS_p , encode_YmdHMS @@ -281,6 +282,33 @@ , MeridiemLocale(..) , TimeInterval(..) , TimeParts(..) + -- * Lenses + , _timeToDatetime + , _datetimeToTime + , _dayToDate + , _dateToDay + , _getDay + , _getDayOfWeek + , _getDayOfMonth + , _getDayOfYear + , _getMonth + , _getOffset + , _getTime + , _getTimespan + , _dateYear + , _dateMonth + , _dateDay + , _ordinalDateYear + , _ordinalDateDayOfYear + , _monthDateMonth + , _monthDateDay + , _datetimeDate + , _datetimeTime + , _offsetDatetimeDatetime + , _offsetDatetimeOffset + , _timeOfDayHour + , _timeOfDayMinute + , _timeOfDayNanoseconds ) where import Control.Applicative @@ -342,6 +370,10 @@ import Chronos.Internal.CTimespec (getPosixNanoseconds) #endif +#if MIN_VERSION_aeson(2,0,0) +import qualified Data.Aeson.Key as AK +#endif + -- $setup -- >>> import Test.QuickCheck hiding (within) -- >>> import Test.QuickCheck.Gen @@ -423,9 +455,27 @@ datetimeToTime :: Datetime -> Time datetimeToTime = fromUtc . datetimeToUtcTime +-- | A lens-compatible variant of half of the `timeToDatetime`/`datetimeToTime` isomorphism. +-- +-- __Note__: We do not provide an iso as that requires a dependence on the `profunctor` +-- package. +_timeToDatetime :: forall f . Functor f => (Datetime -> f Datetime) -> Time -> f Time +_timeToDatetime f = fmap datetimeToTime . f . timeToDatetime + +-- | A lens-compatible variant of half of the `timeToDatetime`/`datetimeToTime` isomorphism. +-- +-- __Note__: We do not provide an iso as that requires a dependence on the `profunctor` +-- package. +_datetimeToTime :: forall f . Functor f => (Time -> f Time) -> Datetime -> f Datetime +_datetimeToTime f = fmap timeToDatetime . f . datetimeToTime + -- | Convert 'Datetime' to 'DayOfWeek' datetimeToDayOfWeek :: Datetime -> DayOfWeek -datetimeToDayOfWeek (Datetime (Date year month date) _) = +datetimeToDayOfWeek (Datetime date _) = dateToDayOfWeek date + +-- | Convert 'Date' to 'DayOfWeek' +dateToDayOfWeek :: Date -> DayOfWeek +dateToDayOfWeek (Date year month date) = let k = getDayOfMonth date m = ((getMonth month + 10) `mod` 12) + 1 y = adjustedYear `mod` 100 @@ -466,6 +516,20 @@ dateToDay (Date y m d) = ordinalDateToDay $ OrdinalDate y (monthDateToDayOfYear (isLeapYear y) (MonthDate m d)) +-- | A lens-compatible variant of half of the `dayToDate`/`dateToDay` isomorphism. +-- +-- __Note__: We do not provide an iso as that requires a dependence on the `profunctor` +-- package. +_dayToDate :: forall f . Functor f => (Date -> f Date) -> Day -> f Day +_dayToDate f = fmap dateToDay . f . dayToDate + +-- | A lens-compatible variant of half of the `dayToDate`/`dateToDay` isomorphism. +-- +-- __Note__: We do not provide an iso as that requires a dependence on the `profunctor` +-- package. +_dateToDay :: forall f . Functor f => (Day -> f Day) -> Date -> f Date +_dateToDay f = fmap dayToDate . f . dateToDay + -- | Construct a 'Datetime' from year, month, day, hour, minute, second: -- -- >>> datetimeFromYmdhms 2014 2 26 17 58 52 @@ -835,7 +899,7 @@ leapYearMonthLength = buildMonthMatch 31 29 31 30 31 30 31 31 30 31 30 31 normalYearMonthLength :: MonthMatch Int -normalYearMonthLength = buildMonthMatch 31 30 31 30 31 30 31 31 30 31 30 31 +normalYearMonthLength = buildMonthMatch 31 28 31 30 31 30 31 31 30 31 30 31 leapYearDayOfYearDayOfMonthTable :: UVector.Vector DayOfMonth leapYearDayOfYearDayOfMonthTable = UVector.fromList $ (DayOfMonth 1:) $ concat @@ -855,7 +919,7 @@ {-# NOINLINE leapYearDayOfYearDayOfMonthTable #-} normalYearDayOfYearDayOfMonthTable :: UVector.Vector DayOfMonth -normalYearDayOfYearDayOfMonthTable = UVector.fromList $ (DayOfMonth 1:) $concat +normalYearDayOfYearDayOfMonthTable = UVector.fromList $ (DayOfMonth 1:) $ concat [ enumFromTo (DayOfMonth 1) (DayOfMonth 31) , enumFromTo (DayOfMonth 1) (DayOfMonth 28) , enumFromTo (DayOfMonth 1) (DayOfMonth 31) @@ -931,6 +995,7 @@ -- | Match a 'DayOfWeek' against a 'DayOfWeekMatch'. caseDayOfWeek :: DayOfWeekMatch a -> DayOfWeek -> a caseDayOfWeek (DayOfWeekMatch v) (DayOfWeek ix) = Vector.unsafeIndex v ix + -- | Given a 'Date' and a separator, construct a 'Text' 'TB.Builder' -- corresponding to Year\/Month\/Day encoding. builder_Ymd :: Maybe Char -> Date -> TB.Builder @@ -946,6 +1011,14 @@ <> sepBuilder <> zeroPadDayOfMonth d +-- | Given a 'Date' and a separator, construct a 'Text.Text' +-- corresponding to a Year\/Month\/Day encoding. +-- +-- >>> encode_Ymd (Just ':') (Date (Year 2022) january (DayOfMonth 13)) +-- "2022:01:13" +encode_Ymd :: Maybe Char -> Date -> Text +encode_Ymd msep = LT.toStrict. TB.toLazyText . builder_Ymd msep + -- | 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 @@ -961,6 +1034,14 @@ <> sepBuilder <> yearToZeroPaddedDigit y +-- | Given a 'Date' and a separator, construct a 'Text.Text' +-- corresponding to a Day\/Month\/Year encoding. +-- +-- >>> encode_Dmy (Just ':') (Date (Year 2022) january (DayOfMonth 13)) +-- "13:01:2022" +encode_Dmy :: Maybe Char -> Date -> Text +encode_Dmy msep = LT.toStrict. TB.toLazyText . builder_Dmy msep + -- | Parse a Year\/Month\/Day-encoded 'Date' that uses the -- given separator. parser_Ymd :: Maybe Char -> Parser Date @@ -1423,6 +1504,9 @@ -- | Construct 'Text' corresponding to the ISO-8601 -- encoding of the given 'Datetime'. +-- +-- >>> encodeIso8601 (datetimeFromYmdhms 2014 2 26 17 58 52) +-- "2014-02-26T17:58:52" encodeIso8601 :: Datetime -> Text encodeIso8601 = LT.toStrict . TB.toLazyText . builderIso8601 @@ -1738,7 +1822,7 @@ -- ByteString stuff --------------- --- | Given a 'SubsecondPrecision' and a separator, construct a 'ByteString' 'BB.Builder' corresponding to an Hour\/Month\/Second encoding of the given 'TimeOfDay'. +-- | Given a 'SubsecondPrecision' and a separator, construct a 'ByteString' 'BB.Builder' corresponding to an Hour\/Minute\/Second encoding of the given 'TimeOfDay'. builderUtf8_HMS :: SubsecondPrecision -> Maybe Char -> TimeOfDay -> BB.Builder builderUtf8_HMS sp msep (TimeOfDay h m ns) = indexTwoDigitByteStringBuilder h @@ -2730,22 +2814,42 @@ add i (Day d) = Day (d + i) difference (Day a) (Day b) = a - b +-- | a lens for accessing the `getDay` field. +_getDay :: Functor f => (Int -> f Int) -> Day -> f Day +_getDay f = fmap Day . f . getDay + -- | The day of the week. newtype DayOfWeek = DayOfWeek { getDayOfWeek :: Int } deriving (Show,Read,Eq,Ord,Hashable,NFData) +-- | a lens for accessing the `getDayOfWeek` field. +_getDayOfWeek :: Functor f => (Int -> f Int) -> DayOfWeek -> f DayOfWeek +_getDayOfWeek f = fmap DayOfWeek . f . getDayOfWeek + -- | The day of the month. newtype DayOfMonth = DayOfMonth { getDayOfMonth :: Int } deriving (Show,Read,Eq,Ord,Prim,Enum,NFData) +-- | a lens for accessing the `getDayOfMonth` field. +_getDayOfMonth :: Functor f => (Int -> f Int) -> DayOfMonth -> f DayOfMonth +_getDayOfMonth f = fmap DayOfMonth . f . getDayOfMonth + -- | The day of the year. newtype DayOfYear = DayOfYear { getDayOfYear :: Int } deriving (Show,Read,Eq,Ord,Prim,NFData) +-- | a lens for accessing the `getDayOfYear` field. +_getDayOfYear :: Functor f => (Int -> f Int) -> DayOfYear -> f DayOfYear +_getDayOfYear f = fmap DayOfYear . f . getDayOfYear + -- | The month of the year. newtype Month = Month { getMonth :: Int } deriving (Show,Read,Eq,Ord,Prim,NFData) +-- | a lens for accessing the `getMonth` field. +_getMonth :: Functor f => (Int -> f Int) -> Month -> f Month +_getMonth f = fmap Month . f . getMonth + instance Enum Month where fromEnum = getMonth toEnum = Month @@ -2767,14 +2871,26 @@ newtype Year = Year { getYear :: Int } deriving (Show,Read,Eq,Ord, NFData) +-- | a lens for accessing the `getYear` field. +_getYear :: Functor f => (Int -> f Int) -> Year -> f Year +_getYear f = fmap Year . f . getYear + -- | A . newtype Offset = Offset { getOffset :: Int } deriving (Show,Read,Eq,Ord,Enum,NFData) +-- | a lens for accessing the `getOffset` field. +_getOffset :: Functor f => (Int -> f Int) -> Offset -> f Offset +_getOffset f = fmap Offset . f . getOffset + -- | POSIX time with nanosecond resolution. newtype Time = Time { getTime :: Int64 } deriving (FromJSON,ToJSON,Hashable,Eq,Ord,Show,Read,Storable,Prim,Bounded, NFData) +-- | a lens for accessing the `getTime` field. +_getTime :: Functor f => (Int64 -> f Int64) -> Time -> f Time +_getTime f = fmap Time . f . getTime + -- | 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 @@ -2799,6 +2915,10 @@ newtype Timespan = Timespan { getTimespan :: Int64 } deriving (Show,Read,Eq,Ord,ToJSON,FromJSON,Additive,NFData) +-- | a lens for accessing the `getTimespan` field. +_getTimespan :: Functor f => (Int64 -> f Int64) -> Timespan -> f Timespan +_getTimespan f = fmap Timespan . f . getTimespan + instance Semigroup Timespan where (Timespan a) <> (Timespan b) = Timespan (a + b) @@ -2838,6 +2958,18 @@ instance NFData Date where rnf (Date y m d) = y `deepseq` m `deepseq` d `deepseq` () +-- | a lens for accessing the `dateYear` field. +_dateYear :: Functor f => (Year -> f Year) -> Date -> f Date +_dateYear f date = fmap (\y -> date{dateYear = y}) . f . dateYear $ date + +-- | a lens for accessing the `dateMonth` field. +_dateMonth :: Functor f => (Month -> f Month) -> Date -> f Date +_dateMonth f date = fmap (\m -> date{dateMonth = m}) . f . dateMonth $ date + +-- | a lens for accessing the `dateDay` field. +_dateDay :: Functor f => (DayOfMonth -> f DayOfMonth) -> Date -> f Date +_dateDay f date = fmap (\d -> date{dateDay = d}) . f . dateDay $ date + -- | An 'OrdinalDate' is a 'Year' and the number of days elapsed -- since the 'Year' began. data OrdinalDate = OrdinalDate @@ -2848,6 +2980,15 @@ instance NFData OrdinalDate where rnf (OrdinalDate y d) = y `deepseq` d `deepseq` () +-- | a lens for accessing the `ordinalDateYear` field. +_ordinalDateYear :: Functor f => (Year -> f Year) -> OrdinalDate -> f OrdinalDate +_ordinalDateYear f date = fmap (\y -> date{ordinalDateYear = y}) . f . ordinalDateYear $ date + +-- | a lens for accessing the `ordinalDateDayOfYear` field. +_ordinalDateDayOfYear :: Functor f => (DayOfYear -> f DayOfYear) -> OrdinalDate -> f OrdinalDate +_ordinalDateDayOfYear f date = + fmap (\d -> date{ordinalDateDayOfYear = d}) . f . ordinalDateDayOfYear $ date + -- | A month and the day of the month. This does not actually represent -- a specific date, since this recurs every year. data MonthDate = MonthDate @@ -2858,6 +2999,14 @@ instance NFData MonthDate where rnf (MonthDate m d) = m `deepseq` d `deepseq` () +-- | a lens for accessing the `monthDateMonth` field. +_monthDateMonth :: Functor f => (Month -> f Month) -> MonthDate -> f MonthDate +_monthDateMonth f date = fmap (\m -> date{monthDateMonth = m}) . f . monthDateMonth $ date + +-- | a lens for accessing the `monthDateDay` field. +_monthDateDay :: Functor f => (DayOfMonth -> f DayOfMonth) -> MonthDate -> f MonthDate +_monthDateDay f date = fmap (\d -> date{monthDateDay = d}) . f . monthDateDay $ date + -- | A 'Date' as represented by the Gregorian calendar -- and a 'TimeOfDay'. -- While the 'ToJSON' instance encodes with a hyphen separator, the @@ -2871,6 +3020,14 @@ instance NFData Datetime where rnf (Datetime d t) = d `deepseq` t `deepseq` () +-- | a lens for accessing the `datetimeDate` field. +_datetimeDate :: Functor f => (Date -> f Date) -> Datetime -> f Datetime +_datetimeDate f date = fmap (\y -> date{datetimeDate = y}) . f . datetimeDate $ date + +-- | a lens for accessing the `datetimeTime` field. +_datetimeTime :: Functor f => (TimeOfDay -> f TimeOfDay) -> Datetime -> f Datetime +_datetimeTime f date = fmap (\t -> date{datetimeTime = t}) . f . datetimeTime $ date + -- | A 'Datetime' with a time zone 'Offset'. data OffsetDatetime = OffsetDatetime { offsetDatetimeDatetime :: {-# UNPACK #-} !Datetime @@ -2880,6 +3037,18 @@ instance NFData OffsetDatetime where rnf (OffsetDatetime dt o) = dt `deepseq` o `deepseq` () +-- | a lens for accessing the `offsetDatetimeDatetime` field. +_offsetDatetimeDatetime + :: Functor f => (Datetime -> f Datetime) -> OffsetDatetime -> f OffsetDatetime +_offsetDatetimeDatetime f date = + fmap (\d -> date{offsetDatetimeDatetime = d}) . f . offsetDatetimeDatetime $ date + +-- | a lens for accessing the `offsetDatetimeOffset` field. +_offsetDatetimeOffset + :: Functor f => (Offset -> f Offset) -> OffsetDatetime -> f OffsetDatetime +_offsetDatetimeOffset f date = + fmap (\y -> date{offsetDatetimeOffset = y}) . f . offsetDatetimeOffset $ date + -- | A time of day with nanosecond resolution. data TimeOfDay = TimeOfDay { timeOfDayHour :: {-# UNPACK #-} !Int @@ -2890,6 +3059,24 @@ instance NFData TimeOfDay where rnf (TimeOfDay h m s) = h `deepseq` m `deepseq` s `deepseq` () +-- | a lens for accessing the `timeOfDayHour` field. +_timeOfDayHour + :: Functor f => (Int -> f Int) -> TimeOfDay -> f TimeOfDay +_timeOfDayHour f time = + fmap (\h -> time{timeOfDayHour = h}) . f . timeOfDayHour $ time + +-- | a lens for accessing the `timeOfDayMinute` field. +_timeOfDayMinute + :: Functor f => (Int -> f Int) -> TimeOfDay -> f TimeOfDay +_timeOfDayMinute f time = + fmap (\m -> time{timeOfDayMinute = m}) . f . timeOfDayMinute $ time + +-- | a lens for accessing the `timeOfDayNanoseconds` field. +_timeOfDayNanoseconds + :: Functor f => (Int64 -> f Int64) -> TimeOfDay -> f TimeOfDay +_timeOfDayNanoseconds f time = + fmap (\n -> time{timeOfDayNanoseconds = n}) . f . timeOfDayNanoseconds $ time + -- | The format of a 'Datetime'. In particular -- this provides separators for parts of the 'Datetime' -- and nothing else. @@ -3122,8 +3309,14 @@ instance ToJSONKey Offset where toJSONKey = AE.ToJSONKeyText - (encodeOffset OffsetFormatColonOn) + (keyFromText . encodeOffset OffsetFormatColonOn) (\x -> AEE.unsafeToEncoding (BB.char7 '"' SG.<> builderOffsetUtf8 OffsetFormatColonOn x SG.<> BB.char7 '"')) + where +#if MIN_VERSION_aeson(2,0,0) + keyFromText = AK.fromText +#else + keyFromText = id +#endif instance FromJSONKey Offset where fromJSONKey = AE.FromJSONKeyTextParser aesonParserOffset @@ -3302,7 +3495,7 @@ -- > 2021-01-05T23:00:52.123000000 -- > 2021-01-05T23:00:53.674094347 boundedBuilderUtf8BytesIso8601Zoneless :: Datetime -> Bounded.Builder 44 -boundedBuilderUtf8BytesIso8601Zoneless (Datetime (Date (Year y) (Month mth) (DayOfMonth d)) (TimeOfDay h mt sns)) = +boundedBuilderUtf8BytesIso8601Zoneless (Datetime (Date (Year y) (Month mth) (DayOfMonth d)) (TimeOfDay h mt sns)) = let (s,ns) = quotRem sns 1_000_000_000 in Bounded.wordDec (fromIntegral y) `Bounded.append` @@ -3337,7 +3530,7 @@ boundedBuilderOffset :: Offset -> Bounded.Builder 6 boundedBuilderOffset (Offset mins) = case mins of 0 -> Bounded.weaken @1 @6 Lte.constant (Bounded.ascii 'Z') - _ -> + _ -> let !absMins = fromIntegral @Int @Word (abs mins) !absHrs = quot absMins 60 !absMinutes = rem absMins 60 diff --git a/test/Doctests.hs b/test/Doctests.hs deleted file mode 100644 --- a/test/Doctests.hs +++ /dev/null @@ -1,8 +0,0 @@ -import Test.DocTest - -main :: IO () -main = doctest - [ "-isrc" - , "src/Chronos.hs" - , "src/Chronos/Locale/English.hs" - ]