thyme 0.3.3.0 → 0.3.4.0
raw patch · 9 files changed
+77/−47 lines, 9 filesdep ~vector
Dependency ranges changed: vector
Files
- include/thyme.h +1/−1
- src/Data/Thyme/Calendar/Internal.hs +22/−20
- src/Data/Thyme/Calendar/WeekdayOfMonth.hs +4/−1
- src/Data/Thyme/Clock/Internal.hs +16/−10
- src/Data/Thyme/Clock/TAI.hs +6/−2
- src/Data/Thyme/Format/Aeson.hs +5/−4
- src/Data/Thyme/Internal/Micro.hs +10/−6
- tests/bench.hs +11/−2
- thyme.cabal +2/−1
include/thyme.h view
@@ -1,5 +1,5 @@ #define INSTANCES_USUAL Eq, Ord, Data, Typeable, Generic-#define INSTANCES_NEWTYPE INSTANCES_USUAL, Enum, Ix, NFData+#define INSTANCES_NEWTYPE INSTANCES_USUAL, Enum, Ix, NFData, MVector VUM.MVector, Vector VU.Vector, VUM.Unbox #define INSTANCES_MICRO INSTANCES_NEWTYPE, Bounded, Random, Arbitrary, CoArbitrary #define LensP Lens' #define LENS(S,F,A) {-# INLINE _/**/F #-}; _/**/F :: LensP S A; _/**/F = lens F $ \ S {..} F/**/_ -> S {F = F/**/_, ..}
src/Data/Thyme/Calendar/Internal.hs view
@@ -25,8 +25,10 @@ import Data.Int import Data.Ix import Data.Thyme.Format.Internal-import Data.Vector.Unboxed (Vector)-import qualified Data.Vector.Unboxed as V+import Data.Vector.Generic (Vector)+import Data.Vector.Generic.Mutable (MVector)+import qualified Data.Vector.Unboxed as VU+import qualified Data.Vector.Unboxed.Mutable as VUM import GHC.Generics (Generic) import System.Random import Test.QuickCheck hiding ((.&.))@@ -44,9 +46,9 @@ instance AffineSpace Day where type Diff Day = Days {-# INLINE (.-.) #-}- ModifiedJulianDay a .-. ModifiedJulianDay b = a - b+ (.-.) = \ (ModifiedJulianDay a) (ModifiedJulianDay b) -> a - b {-# INLINE (.+^) #-}- ModifiedJulianDay a .+^ d = ModifiedJulianDay (a + d)+ (.+^) = \ (ModifiedJulianDay a) d -> ModifiedJulianDay (a + d) {-# INLINE modifiedJulianDay #-} modifiedJulianDay :: Iso' Day Int@@ -146,28 +148,28 @@ {-# NOINLINE monthLengths #-} {-# NOINLINE monthLengthsLeap #-}-monthLengths, monthLengthsLeap :: Vector Days-monthLengths = V.fromList [31,28,31,30,31,30,31,31,30,31,30,31]-monthLengthsLeap = V.fromList [31,29,31,30,31,30,31,31,30,31,30,31]+monthLengths, monthLengthsLeap :: VU.Vector Days+monthLengths = VU.fromList [31,28,31,30,31,30,31,31,30,31,30,31]+monthLengthsLeap = VU.fromList [31,29,31,30,31,30,31,31,30,31,30,31] -- J F M A M J J A S O N D {-# ANN monthDays "HLint: ignore Use fromMaybe" #-} {-# NOINLINE monthDays #-}-monthDays :: Vector ({-Month-}Int8, {-DayOfMonth-}Int8)-monthDays = V.generate 365 go where- dom01 = V.prescanl' (+) 0 monthLengths+monthDays :: VU.Vector ({-Month-}Int8, {-DayOfMonth-}Int8)+monthDays = VU.generate 365 go where+ dom01 = VU.prescanl' (+) 0 monthLengths go yd = (fromIntegral m, fromIntegral d) where- m = maybe 12 id $ V.findIndex (yd <) dom01- d = succ yd - V.unsafeIndex dom01 (pred m)+ m = maybe 12 id $ VU.findIndex (yd <) dom01+ d = succ yd - VU.unsafeIndex dom01 (pred m) {-# ANN monthDaysLeap "HLint: ignore Use fromMaybe" #-} {-# NOINLINE monthDaysLeap #-}-monthDaysLeap :: Vector ({-Month-}Int8, {-DayOfMonth-}Int8)-monthDaysLeap = V.generate 366 go where- dom01 = V.prescanl' (+) 0 monthLengthsLeap+monthDaysLeap :: VU.Vector ({-Month-}Int8, {-DayOfMonth-}Int8)+monthDaysLeap = VU.generate 366 go where+ dom01 = VU.prescanl' (+) 0 monthLengthsLeap go yd = (fromIntegral m, fromIntegral d) where- m = maybe 12 id $ V.findIndex (yd <) dom01- d = succ yd - V.unsafeIndex dom01 (pred m)+ m = maybe 12 id $ VU.findIndex (yd <) dom01+ d = succ yd - VU.unsafeIndex dom01 (pred m) -- | No good home for this within the current hierarchy. This will do. {-# INLINEABLE randomIsoR #-}@@ -211,13 +213,13 @@ {-# INLINE fromOrdinal #-} fromOrdinal :: DayOfYear -> MonthDay fromOrdinal (max 0 . min lastDay . pred -> i) = MonthDay m d where- (fromIntegral -> m, fromIntegral -> d) = V.unsafeIndex table i+ (fromIntegral -> m, fromIntegral -> d) = VU.unsafeIndex table i {-# INLINE toOrdinal #-} toOrdinal :: MonthDay -> DayOfYear toOrdinal (MonthDay month day) = div (367 * m - 362) 12 + k + d where m = max 1 . min 12 $ month- l = V.unsafeIndex lengths (pred m)+ l = VU.unsafeIndex lengths (pred m) d = max 1 . min l $ day k = if m <= 2 then 0 else ok @@ -228,7 +230,7 @@ {-# INLINEABLE monthLength #-} monthLength :: Bool -> Month -> Days-monthLength leap = V.unsafeIndex ls . max 0 . min 11 . pred where+monthLength leap = VU.unsafeIndex ls . max 0 . min 11 . pred where ls = if leap then monthLengthsLeap else monthLengths ------------------------------------------------------------------------
src/Data/Thyme/Calendar/WeekdayOfMonth.hs view
@@ -5,7 +5,10 @@ {-# LANGUAGE ViewPatterns #-} #include "thyme.h" -module Data.Thyme.Calendar.WeekdayOfMonth where+module Data.Thyme.Calendar.WeekdayOfMonth+ ( Year, Month, DayOfWeek+ , module Data.Thyme.Calendar.WeekdayOfMonth+ ) where import Prelude import Control.Applicative
src/Data/Thyme/Clock/Internal.hs view
@@ -23,6 +23,10 @@ import Data.Ix import Data.Thyme.Internal.Micro import Data.Thyme.Calendar.Internal+import Data.Vector.Generic (Vector)+import Data.Vector.Generic.Mutable (MVector)+import qualified Data.Vector.Unboxed as VU+import qualified Data.Vector.Unboxed.Mutable as VUM import Data.VectorSpace import GHC.Generics (Generic) import System.Random@@ -69,9 +73,11 @@ ------------------------------------------------------------------------ -- not for public consumption +{-# INLINE fromSecondsRealFrac #-} fromSecondsRealFrac :: (RealFrac n, TimeDiff t) => n -> n -> t fromSecondsRealFrac _ = review microseconds . round . (*) 1000000 +{-# INLINE fromSecondsIntegral #-} fromSecondsIntegral :: (Integral n, TimeDiff t) => n -> n -> t fromSecondsIntegral _ = review microseconds . (*) 1000000 . fromIntegral @@ -113,16 +119,16 @@ instance VectorSpace DiffTime where type Scalar DiffTime = Rational {-# INLINE (*^) #-}- s *^ DiffTime t = DiffTime (s *^ t)+ (*^) = \ s (DiffTime t) -> DiffTime (s *^ t) instance HasBasis DiffTime where type Basis DiffTime = () {-# INLINE basisValue #-}- basisValue () = DiffTime (basisValue ())+ basisValue = \ _ -> DiffTime (basisValue ()) {-# INLINE decompose #-}- decompose (DiffTime a) = decompose a+ decompose = \ (DiffTime a) -> decompose a {-# INLINE decompose' #-}- decompose' (DiffTime a) = decompose' a+ decompose' = \ (DiffTime a) -> decompose' a instance TimeDiff DiffTime where {-# INLINE microseconds #-}@@ -161,16 +167,16 @@ instance VectorSpace NominalDiffTime where type Scalar NominalDiffTime = Rational {-# INLINE (*^) #-}- s *^ NominalDiffTime t = NominalDiffTime (s *^ t)+ (*^) = \ s (NominalDiffTime t) -> NominalDiffTime (s *^ t) instance HasBasis NominalDiffTime where type Basis NominalDiffTime = () {-# INLINE basisValue #-}- basisValue () = NominalDiffTime (basisValue ())+ basisValue = \ _ -> NominalDiffTime (basisValue ()) {-# INLINE decompose #-}- decompose (NominalDiffTime a) = decompose a+ decompose = \ (NominalDiffTime a) -> decompose a {-# INLINE decompose' #-}- decompose' (NominalDiffTime a) = decompose' a+ decompose' = \ (NominalDiffTime a) -> decompose' a instance TimeDiff NominalDiffTime where {-# INLINE microseconds #-}@@ -245,9 +251,9 @@ instance AffineSpace UTCTime where type Diff UTCTime = NominalDiffTime {-# INLINE (.-.) #-}- UTCRep a .-. UTCRep b = a ^-^ b+ (.-.) = \ (UTCRep a) (UTCRep b) -> a ^-^ b {-# INLINE (.+^) #-}- UTCRep a .+^ d = UTCRep (a ^+^ d)+ (.+^) = \ (UTCRep a) d -> UTCRep (a ^+^ d) -- | View 'UTCTime' as an 'UTCView', comprising a 'Day' along with -- a 'DiffTime' offset since midnight.
src/Data/Thyme/Clock/TAI.hs view
@@ -44,6 +44,10 @@ import Data.Thyme.Clock.Internal import Data.Thyme.Format.Internal import Data.Thyme.LocalTime+import Data.Vector.Generic (Vector)+import Data.Vector.Generic.Mutable (MVector)+import qualified Data.Vector.Unboxed as VU+import qualified Data.Vector.Unboxed.Mutable as VUM import Data.VectorSpace import GHC.Generics (Generic) import System.Locale@@ -65,9 +69,9 @@ instance AffineSpace AbsoluteTime where type Diff AbsoluteTime = DiffTime {-# INLINE (.-.) #-}- AbsoluteTime a .-. AbsoluteTime b = a ^-^ b+ (.-.) = \ (AbsoluteTime a) (AbsoluteTime b) -> a ^-^ b {-# INLINE (.+^) #-}- AbsoluteTime a .+^ d = AbsoluteTime (a ^+^ d)+ (.+^) = \ (AbsoluteTime a) d -> AbsoluteTime (a ^+^ d) type LeapSecondTable = Either UTCTime AbsoluteTime -> DiffTime
src/Data/Thyme/Format/Aeson.hs view
@@ -24,7 +24,7 @@ -- (c) 2011 MailRank, Inc. --------------------------------------------------------------------------- Copypasta from aeson-0.7.0.0:Data.Aeson.Types.Internal+-- Copypasta from aeson-0.7.1.0:Data.Aeson.Types.Internal -- | A newtype wrapper for 'UTCTime' that uses the same non-standard -- serialization format as Microsoft .NET, whose @System.DateTime@@@ -38,7 +38,7 @@ } deriving (Eq, Ord, Read, Show, Typeable, FormatTime) --------------------------------------------------------------------------- Copypasta from aeson-0.7.0.0:Data.Aeson.Types.Instances+-- Copypasta from aeson-0.7.1.0:Data.Aeson.Types.Instances instance ToJSON DotNetTime where toJSON (DotNetTime t) =@@ -88,8 +88,9 @@ parseJSON v = typeMismatch "ZonedTime" v instance ToJSON UTCTime where- toJSON t = String (pack (take 23 str ++ "Z"))- where str = formatTime defaultTimeLocale "%FT%T.%q" t+ toJSON t = String $ pack $ formatTime defaultTimeLocale format t+ where+ format = "%FT%T." ++ formatMillis t ++ "Z" {-# INLINE toJSON #-} instance FromJSON UTCTime where
src/Data/Thyme/Internal/Micro.hs view
@@ -19,6 +19,10 @@ import Data.Int import Data.Ix import Data.Ratio+import Data.Vector.Generic (Vector)+import Data.Vector.Generic.Mutable (MVector)+import qualified Data.Vector.Unboxed as VU+import qualified Data.Vector.Unboxed.Mutable as VUM import Data.VectorSpace import GHC.Generics (Generic) import System.Random@@ -70,13 +74,13 @@ {-# INLINE zeroV #-} zeroV = Micro 0 {-# INLINE (^+^) #-}- Micro a ^+^ Micro b = Micro (a + b)+ (^+^) = \ (Micro a) (Micro b) -> Micro (a + b) {-# INLINE negateV #-}- negateV (Micro a) = Micro (negate a)+ negateV = \ (Micro a) -> Micro (negate a) instance VectorSpace Micro where type Scalar Micro = Rational- {-# INLINE (*^) #-}+ {-# INLINEABLE (*^) #-} s *^ Micro a = Micro . fromInteger $ case compare (2 * abs r) (denominator s) of LT -> n@@ -89,9 +93,9 @@ instance HasBasis Micro where type Basis Micro = () {-# INLINE basisValue #-}- basisValue () = Micro 1000000+ basisValue = \ _ -> Micro 1000000 {-# INLINE decompose #-}- decompose (Micro a) = [((), fromIntegral a % 1000000)]+ decompose = \ (Micro a) -> [((), fromIntegral a % 1000000)] {-# INLINE decompose' #-}- decompose' (Micro a) = const (fromIntegral a % 1000000)+ decompose' = \ (Micro a) _ -> fromIntegral a % 1000000
tests/bench.hs view
@@ -25,6 +25,7 @@ import qualified Data.Time.Calendar.WeekDate as T import qualified Data.Time.Calendar.MonthDay as T import qualified Data.Time.Clock.POSIX as T+import qualified Data.Vector as V import Test.QuickCheck as QC import Test.QuickCheck.Gen as QC #if MIN_VERSION_QuickCheck(2,7,0)@@ -42,13 +43,14 @@ {-# ANN main "HLint: ignore Use list literal" #-} main :: IO () main = do- utcs <- unGen (vectorOf samples arbitrary)+ -- unboxed vectors made things a little too unfair for time+ utcs <- fmap V.fromList $ unGen (vectorOf samples arbitrary) #if MIN_VERSION_QuickCheck(2,7,0) <$> QC.newQCGen <*> pure 0 #else <$> newStdGen <*> pure 0 #endif- let utcs' = review thyme <$> (utcs :: [UTCTime])+ let utcs' = review thyme <$> utcs now <- getCurrentTime let now' = thyme # now let strs = T.formatTime defaultTimeLocale spec <$> utcs'@@ -60,6 +62,8 @@ let years' = (\ (y, _m, _d) -> y) . T.toGregorian <$> days' let mons = ((isLeapYear . ymdYear) &&& ymdMonth) . view gregorian <$> days let ords = ((isLeapYear . odYear) &&& odDay) . view ordinalDate <$> days+ let pxs = utcTimeToPOSIXSeconds <$> utcs+ let pxs' = T.utcTimeToPOSIXSeconds <$> utcs' let config = defaultConfig {cfgVerbosity = Last (Just Quiet)} (exit . and <=< withConfig config) $ do@@ -112,6 +116,11 @@ ( "utcTimeToPOSIXSeconds", 10 , nf (utcTimeToPOSIXSeconds <$>) utcs , nf (T.utcTimeToPOSIXSeconds <$>) utcs' ) :++ -- toSeconds+ ( "toSeconds", 45+ , nf ((toSeconds :: NominalDiffTime -> Double) <$>) pxs+ , nf ((realToFrac :: T.NominalDiffTime -> Double) <$>) pxs' ) : -- LocalTime ( "timeToTimeOfDay", 40
thyme.cabal view
@@ -1,5 +1,5 @@ name: thyme-version: 0.3.3.0+version: 0.3.4.0 synopsis: A faster time library description: Thyme is a rewrite of the fine @time@ library, with a particular focus@@ -175,6 +175,7 @@ random, thyme, time,+ vector, vector-space if flag(lens) build-depends: lens