diff --git a/bench/Bench.hs b/bench/Bench.hs new file mode 100644 --- /dev/null +++ b/bench/Bench.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE BangPatterns #-} + +module Main where + +import qualified Data.Vector.Unboxed as UVector +import Criterion.Main +import Data.Int +import Data.Maybe (fromMaybe) +import Control.DeepSeq (($!!), NFData(..), deepseq) +import qualified Data.ByteString.Char8 as BS8 +import Test.QuickCheck (arbitrary, generate) +import Data.Attoparsec.ByteString.Char8 (Parser, parseOnly, char) +import qualified Data.Attoparsec.Zepto as Z +import Data.Foldable (traverse_) +import Data.Word +import Control.Monad (when) +import Control.Applicative + +import qualified Data.Time as Time +import qualified Data.Thyme as Thyme +import qualified System.Locale as Thyme +import qualified Chronos + +main :: IO () +main = do + utcthyme <- generate arbitrary :: IO Thyme.UTCTime + let + isoFormatString = "%Y-%m-%dT%H:%M:%S" + renderIsoTime = Thyme.formatTime Thyme.defaultTimeLocale isoFormatString + timeParser :: String -> Time.UTCTime + timeParser = + fromMaybe (error "Failed to parse in timeParser") + . Time.parseTimeM True Time.defaultTimeLocale isoFormatString + thymeParser :: String -> Thyme.UTCTime + thymeParser = + fromMaybe (error "Failed to parse in thymeParser") + . Thyme.parseTime Thyme.defaultTimeLocale isoFormatString + thymeAttoparsec :: BS8.ByteString -> Thyme.UTCTime + thymeAttoparsec = + Thyme.buildTime @Thyme.UTCTime + . either error id + . parseOnly (Thyme.timeParser Thyme.defaultTimeLocale isoFormatString) + chronosAttoparsec :: BS8.ByteString -> Chronos.Datetime + chronosAttoparsec = + either error id + . parseOnly (Chronos.parserUtf8_YmdHMS Chronos.w3c) + chronosZepto :: BS8.ByteString -> Chronos.Datetime + chronosZepto = + either error id + . Z.parse (Chronos.zeptoUtf8_YmdHMS Chronos.w3c) + + + string <- return $!! renderIsoTime utcthyme + bytestring <- return $!! BS8.pack (renderIsoTime utcthyme) + + defaultMain + [ bgroup "parsing" + [ bench "Time.parseTimeM" $ nf timeParser string + , bench "Thyme.parseTime" $ nf thymeParser string + , bench "Thyme.timeParser" $ nf thymeAttoparsec bytestring + , bench "Chronos.parserUtf8_YmdHMS" $ nf chronosAttoparsec bytestring + , bench "Chronos.zeptoUtf8_YmdHMS" $ nf chronosZepto bytestring + ] + ] + +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 diff --git a/chronos.cabal b/chronos.cabal --- a/chronos.cabal +++ b/chronos.cabal @@ -1,5 +1,5 @@ name: chronos -version: 1.0.3 +version: 1.0.4 synopsis: A performant time library description: Performance-oriented time library for haskell. The main differences @@ -73,6 +73,24 @@ , HUnit , test-framework-hunit ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +benchmark bench + type: exitcode-stdio-1.0 + hs-source-dirs: bench + main-is: Bench.hs + build-depends: + base + , attoparsec + , bytestring + , chronos + , criterion + , deepseq + , old-locale + , QuickCheck + , thyme + , time + , vector default-language: Haskell2010 source-repository head diff --git a/src/Chronos.hs b/src/Chronos.hs --- a/src/Chronos.hs +++ b/src/Chronos.hs @@ -106,6 +106,7 @@ , builderUtf8_IMSp , parserUtf8_HMS , parserUtf8_HMS_opt_S + , zeptoUtf8_HMS -- ** Datetime -- *** Text , builder_DmyHMS @@ -138,6 +139,7 @@ , decodeUtf8_YmdHMS_opt_S , parserUtf8_YmdHMS , parserUtf8_YmdHMS_opt_S + , zeptoUtf8_YmdHMS -- ** Offset Datetime -- *** Text , encode_YmdHMSz @@ -167,8 +169,8 @@ , parserOffsetUtf8 -- ** Timespan -- *** Text - , encodeTimespan - , builderTimespan + , encodeTimespan + , builderTimespan -- *** UTF-8 ByteString , encodeTimespanUtf8 , builderTimespanUtf8 @@ -209,7 +211,7 @@ import Data.ByteString (ByteString) import Torsor (add,difference,scale,plus) import Chronos.Internal.CTimespec (getPosixNanoseconds) -import Data.Word (Word64) +import Data.Word (Word64, Word8) import Torsor import GHC.Generics (Generic) import Data.Aeson (FromJSON,ToJSON,FromJSONKey,ToJSONKey) @@ -222,6 +224,7 @@ import qualified Data.Aeson.Types as AET import qualified Data.Attoparsec.ByteString.Char8 as AB import qualified Data.Attoparsec.Text as AT +import qualified Data.Attoparsec.Zepto as Z import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as LB @@ -273,7 +276,7 @@ offsetDatetimeToTime :: OffsetDatetime -> Time offsetDatetimeToTime = fromUtc . offsetDatetimeToUtcTime --- | Convert 'Time' to 'Day'. This function is lossy; consequently, it +-- | Convert 'Time' to 'Day'. This function is lossy; consequently, it -- does not roundtrip with 'dayToTimeMidnight'. timeToDayTruncate :: Time -> Day timeToDayTruncate (Time i) = Day (fromIntegral (div i 86400000000000) + 40587) @@ -544,7 +547,7 @@ year = quadcent * 400 + cent * 100 + quad * 4 + y + 1 {- $format - + The formats provided is this module are language-agnostic. To find meridiem formats and month formats, look in a language-specific module. @@ -747,7 +750,6 @@ when (d < 1 || d > 31) (fail "day must be between 1 and 31") return (Date (Year y) (Month $ m - 1) (DayOfMonth d)) - builder_HMS :: SubsecondPrecision -> Maybe Char -> TimeOfDay -> TB.Builder builder_HMS sp msep (TimeOfDay h m ns) = indexTwoDigitTextBuilder h @@ -907,7 +909,7 @@ LT.toStrict . TB.toLazyText . builderTimespan sp builderTimespan :: SubsecondPrecision -> Timespan -> TB.Builder -builderTimespan sp (Timespan ns) = +builderTimespan sp (Timespan ns) = TB.decimal sInt64 <> prettyNanosecondsBuilder sp nsRemainder where (!sInt64,!nsRemainder) = quotRem ns 1000000000 @@ -931,7 +933,7 @@ builder_DmyHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> TB.Builder -builder_DmyHMS sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) = +builder_DmyHMS sp (DatetimeFormat mdateSep msep mtimeSep) (Datetime date time) = case msep of Nothing -> builder_Dmy mdateSep date <> builder_HMS sp mtimeSep time @@ -953,7 +955,7 @@ encode_DmyHMS :: SubsecondPrecision -> DatetimeFormat -> Datetime -> Text -encode_DmyHMS sp format = +encode_DmyHMS sp format = LT.toStrict . TB.toLazyText . builder_DmyHMS sp format encode_DmyIMS_p :: MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> Datetime -> Text @@ -1200,7 +1202,7 @@ LB.toStrict . BB.toLazyByteString . builderTimespanUtf8 sp builderTimespanUtf8 :: SubsecondPrecision -> Timespan -> BB.Builder -builderTimespanUtf8 sp (Timespan ns) = +builderTimespanUtf8 sp (Timespan ns) = int64Builder sInt64 <> prettyNanosecondsBuilderUtf8 sp nsRemainder where (!sInt64,!nsRemainder) = quotRem ns 1000000000 @@ -1299,7 +1301,7 @@ LT.toStrict . TB.toLazyText . builder_YmdHMSz offsetFormat sp datetimeFormat builder_DmyHMSz :: OffsetFormat -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> TB.Builder -builder_DmyHMSz offsetFormat sp datetimeFormat (OffsetDatetime datetime offset) = +builder_DmyHMSz offsetFormat sp datetimeFormat (OffsetDatetime datetime offset) = builder_DmyHMS sp datetimeFormat datetime <> builderOffset offsetFormat offset @@ -1309,7 +1311,7 @@ <*> parserOffset offsetFormat builder_DmyIMS_p_z :: OffsetFormat -> MeridiemLocale Text -> SubsecondPrecision -> DatetimeFormat -> OffsetDatetime -> TB.Builder -builder_DmyIMS_p_z offsetFormat meridiemLocale sp datetimeFormat (OffsetDatetime datetime offset) = +builder_DmyIMS_p_z offsetFormat meridiemLocale sp datetimeFormat (OffsetDatetime datetime offset) = builder_DmyIMS_p meridiemLocale sp datetimeFormat datetime <> " " <> builderOffset offsetFormat offset @@ -1592,6 +1594,83 @@ <> ":" <> indexTwoDigitByteStringBuilder b +-- Zepto parsers + +zeptoUtf8_YmdHMS :: DatetimeFormat -> Z.Parser Datetime +zeptoUtf8_YmdHMS (DatetimeFormat mdateSep msep' mtimeSep) = do + date <- zeptoUtf8_Ymd mdateSep + let msep = BC.singleton <$> msep' + traverse_ Z.string msep + time <- zeptoUtf8_HMS mtimeSep + return (Datetime date time) + +zeptoCountZeroes :: Z.Parser Int +zeptoCountZeroes = do + bs <- Z.takeWhile (0x30 ==) + pure $! BC.length bs + +zeptoUtf8_Ymd :: Maybe Char -> Z.Parser Chronos.Date +zeptoUtf8_Ymd msep' = do + y <- zeptoFixedDigitsIntBS 4 + let msep = BC.singleton <$> msep' + traverse_ Z.string msep + m <- zeptoFixedDigitsIntBS 2 + when (m < 1 || m > 12) (fail "month must be between 1 and 12") + traverse_ Z.string msep + d <- zeptoFixedDigitsIntBS 2 + when (d < 1 || d > 31) (fail "day must be between 1 and 31") + return (Date (Year y) (Month $ m - 1) (DayOfMonth d)) + +zeptoUtf8_HMS :: Maybe Char -> Z.Parser Chronos.TimeOfDay +zeptoUtf8_HMS msep' = do + h <- zeptoFixedDigitsIntBS 2 + when (h > 23) (fail "hour must be between 0 and 23") + let msep = BC.singleton <$> msep' + traverse_ Z.string msep + m <- zeptoFixedDigitsIntBS 2 + when (m > 59) (fail "minute must be between 0 and 59") + traverse_ Z.string msep + ns <- zeptoSecondsAndNanosecondsUtf8 + return (TimeOfDay h m ns) + +zeptoFixedDigitsIntBS :: Int -> Z.Parser Int +zeptoFixedDigitsIntBS n = do + t <- Z.take n + case BC.readInt t of + Nothing -> fail "datetime decoding could not parse integral bytestring (a)" + Just (i,r) -> if BC.null r + then return i + else fail "datetime decoding could not parse integral bytestring (b)" + +zeptoSecondsAndNanosecondsUtf8 :: Z.Parser Int64 +zeptoSecondsAndNanosecondsUtf8 = do + s' <- zeptoFixedDigitsIntBS 2 + let s = fromIntegral s' :: Int64 + when (s > 60) (fail "seconds must be between 0 and 60") + nanoseconds <- + ( do _ <- Z.string "." + numberOfZeroes <- zeptoCountZeroes + x <- zdecimal + let totalDigits = countDigits x + numberOfZeroes + result = if totalDigits == 9 + then x + else if totalDigits < 9 + then x * raiseTenTo (9 - totalDigits) + else quot x (raiseTenTo (totalDigits - 9)) + return (fromIntegral result) + ) <|> return 0 + return (s * 1000000000 + nanoseconds) + +zdecimal :: Z.Parser Int64 +zdecimal = do + digits <- Z.takeWhile wordIsDigit + case BC.readInt digits of + Nothing -> fail "somehow this didn't work" + Just (i,_) -> pure $! fromIntegral i + +wordIsDigit :: Word8 -> Bool +wordIsDigit a = 0x30 <= a && a <= 0x39 + january :: Month january = Month 0 @@ -2087,4 +2166,3 @@ aesonParserOffset t = case decodeOffset OffsetFormatColonOn t of Nothing -> fail "could not parse Offset" Just x -> return x - 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 @@ -51,6 +51,3 @@ return ((s * 1000000000) + ns) #endif - - - diff --git a/src/cbits/hs-time.c b/src/cbits/hs-time.c --- a/src/cbits/hs-time.c +++ b/src/cbits/hs-time.c @@ -1,5 +1,10 @@ #ifdef __MACH__ +#include #include + +#ifdef __MAC_OS_X_VERSION_MIN_REQUIRED + +#if __MAC_OS_X_VERSION_MIN_REQUIRED < 1012 //clock_gettime is not implemented on OSX int clock_gettime(int clk_id, struct timespec* t) { struct timeval now; @@ -9,4 +14,9 @@ t->tv_nsec = now.tv_usec * 1000; return 0; } +#else +#endif + +#endif + #endif