thyme 0.2.2.0 → 0.2.3.0
raw patch · 10 files changed
+339/−171 lines, 10 filesdep +vectordep ~basedep ~lensdep ~old-locale
Dependencies added: vector
Dependency ranges changed: base, lens, old-locale, time, vector-space
Files
- src/Data/Micro.hs +0/−35
- src/Data/Thyme/Calendar/Internal.hs +28/−0
- src/Data/Thyme/Calendar/MonthDay.hs +16/−8
- src/Data/Thyme/Clock.hs +22/−0
- src/Data/Thyme/Clock/Internal.hs +0/−14
- src/Data/Thyme/Time.hs +52/−4
- tests/Common.hs +70/−0
- tests/bench.hs +129/−0
- tests/sanity.hs +3/−101
- thyme.cabal +19/−9
src/Data/Micro.hs view
@@ -56,41 +56,6 @@ toMicro :: Rational -> Micro toMicro r = Micro (fromInteger $ 1000000 * numerator r `div` denominator r) -#if INSTANCE_NUM-instance Num Micro where- {-# INLINE (+) #-}- {-# INLINE (-) #-}- {-# INLINE (*) #-}- {-# INLINE negate #-}- {-# INLINE abs #-}- {-# INLINE signum #-}- {-# INLINE fromInteger #-}- Micro a + Micro b = Micro (a + b)- Micro a - Micro b = Micro (a - b)- Micro a * Micro b = Micro (quot a 1000 * quot b 1000)- negate (Micro a) = Micro (negate a)- abs (Micro a) = Micro (abs a)- signum (Micro a) = Micro (signum a * 1000000)- fromInteger a = Micro (fromInteger a * 1000000)--instance Real Micro where- {-# INLINE toRational #-}- toRational (Micro a) = toInteger a % 1000000--instance Fractional Micro where- {-# INLINE (/) #-}- {-# INLINE recip #-}- {-# INLINE fromRational #-}- Micro a / Micro b = Micro (quot (a * 1000) (b * 1000))- recip (Micro a) = Micro (quot 1000000 a)- fromRational = toMicro--instance RealFrac Micro where- {-# INLINE properFraction #-}- properFraction a = (fromIntegral q, r) where- (q, r) = microQuotRem a (Micro 1000000)-#endif- {-# INLINE microQuotRem #-} {-# INLINE microDivMod #-} microQuotRem, microDivMod :: Micro -> Micro -> (Int64, Micro)
src/Data/Thyme/Calendar/Internal.hs view
@@ -17,6 +17,8 @@ import Data.Int import Data.Ix import Data.Thyme.Format.Internal+import Data.Vector.Unboxed (Vector)+import qualified Data.Vector.Unboxed as V type Years = Int type Months = Int@@ -90,6 +92,32 @@ mjd = 365 * y + div y 4 - div y 100 + div y 400 - 678576 + clip 1 (if isLeapYear year then 366 else 365) (fromIntegral yd) clip a b = max a . min b++------------------------------------------------------------------------+-- Lookup tables for Data.Thyme.Calendar.MonthDay++{-# 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]+ -- J F M A M J J A S O N D++{-# NOINLINE monthDays #-}+monthDays :: Vector ({-Month-}Int8, {-DayOfMonth-}Int8)+monthDays = V.generate 365 go where+ first = V.prescanl' (+) 0 monthLengths+ go yd = (fromIntegral m, fromIntegral d) where+ m = maybe 12 id $ V.findIndex (yd <) first+ d = succ yd - V.unsafeIndex first (pred m)++{-# NOINLINE monthDaysLeap #-}+monthDaysLeap :: Vector ({-Month-}Int8, {-DayOfMonth-}Int8)+monthDaysLeap = V.generate 366 go where+ first = V.prescanl' (+) 0 monthLengthsLeap+ go yd = (fromIntegral m, fromIntegral d) where+ m = maybe 12 id $ V.findIndex (yd <) first+ d = succ yd - V.unsafeIndex first (pred m) ------------------------------------------------------------------------
src/Data/Thyme/Calendar/MonthDay.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ViewPatterns #-} -- | Julian or Gregorian. module Data.Thyme.Calendar.MonthDay@@ -14,9 +15,9 @@ import Control.Lens import Control.Monad import Data.Data-import qualified Data.Time.Calendar.MonthDay as T import Data.Thyme.Calendar.Internal import Data.Thyme.TH+import qualified Data.Vector.Unboxed as V data MonthDay = MonthDay { mdMonth :: {-# UNPACK #-}!Month@@ -30,25 +31,32 @@ {-# INLINE monthDay #-} monthDay :: Bool -> Iso' DayOfYear MonthDay monthDay leap = iso fromOrdinal toOrdinal where- -- TODO: Calls non-inlineable code from @time@. Pilfer and optimise?+ (lastDay, lengths, table, ok) = if leap+ then (365, monthLengthsLeap, monthDaysLeap, -1)+ else (364, monthLengths, monthDays, -2) {-# INLINE fromOrdinal #-} fromOrdinal :: DayOfYear -> MonthDay- fromOrdinal yd = MonthDay m d where- (m, d) = T.dayOfYearToMonthAndDay leap yd+ fromOrdinal (max 0 . min lastDay . pred -> i) = MonthDay m d where+ (fromIntegral -> m, fromIntegral -> d) = V.unsafeIndex table i {-# INLINE toOrdinal #-} toOrdinal :: MonthDay -> DayOfYear- toOrdinal (MonthDay m d) = T.monthAndDayToDayOfYear leap m d+ toOrdinal (MonthDay month day) = div (367 * m - 362) 12 + k + d where+ m = max 1 . min 12 $ month+ l = V.unsafeIndex lengths (pred m)+ d = max 1 . min l $ day+ k = if m <= 2 then 0 else ok {-# INLINEABLE monthDayValid #-} monthDayValid :: Bool -> MonthDay -> Maybe DayOfYear monthDayValid leap md@(MonthDay m d) = review (monthDay leap) md- <$ guard (1 <= m && m <= 12 && 1 <= d && d <= T.monthLength leap m)+ <$ guard (1 <= m && m <= 12 && 1 <= d && d <= monthLength leap m) -{-# INLINE monthLength #-}+{-# INLINEABLE monthLength #-} monthLength :: Bool -> Month -> Days-monthLength = T.monthLength+monthLength leap = V.unsafeIndex ls . max 0 . min 11 . pred where+ ls = if leap then monthLengthsLeap else monthLengths -- * Lenses thymeLenses ''MonthDay
src/Data/Thyme/Clock.hs view
@@ -1,6 +1,28 @@ {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +-- | 'Num', 'Real', 'Fractional' and 'RealFrac' instances for 'DiffTime' and+-- 'NominalDiffTime' are only available by importing "Data.Thyme.Time". In+-- their stead, instances of 'Data.AdditiveGroup.AdditiveGroup',+-- 'Data.Basis.HasBasis' and 'Data.VectorSpace.VectorSpace' are given here.+-- Addition and subtraction are performed with the 'Data.AdditiveGroup.^+^'+-- and 'Data.AdditiveGroup.^-^' operators from+-- 'Data.AdditiveGroup.AdditiveGroup', while 'Data.VectorSpace.*^' scales by+-- a 'Rational'. To find the ratio of two time differences, define:+--+-- @+-- (^\/^) :: ('Data.Basis.HasBasis' v, 'Data.Basis.Basis' v ~ (), 'Data.VectorSpace.Scalar' v ~ s, 'Prelude.Fractional' s) => v -> v -> s+-- (^\/^) = ('Prelude./') '`Data.Function.on`' flip 'Data.Basis.decompose'' ()+-- @+--+-- Finally, write @n 'Data.VectorSpace.*^' 'Data.Basis.basisValue' ()@ where+-- literals are expected.+--+-- 'UniversalTime' and 'UTCTime' are instances of+-- 'Data.AffineSpace.AffineSpace', with @'Data.AffineSpace.Diff'+-- 'UniversalTime' ≡ 'DiffTime'@, and @'Data.AffineSpace.Diff' 'UTCTime' ≡+-- 'NominalDiffTime'@.+ module Data.Thyme.Clock ( -- * Universal Time UniversalTime
src/Data/Thyme/Clock/Internal.hs view
@@ -55,13 +55,6 @@ {-# INLINE decompose' #-} decompose' (DiffTime a) = decompose' a -#if INSTANCE_NUM-deriving instance Num DiffTime-deriving instance Real DiffTime-deriving instance Fractional DiffTime-deriving instance RealFrac DiffTime-#endif- {-# INLINE microDiffTime #-} microDiffTime :: Iso' Int64 DiffTime microDiffTime = iso (DiffTime . Micro) (\ (DiffTime (Micro u)) -> u)@@ -94,13 +87,6 @@ decompose (NominalDiffTime a) = decompose a {-# INLINE decompose' #-} decompose' (NominalDiffTime a) = decompose' a--#if INSTANCE_NUM-deriving instance Num NominalDiffTime-deriving instance Real NominalDiffTime-deriving instance Fractional NominalDiffTime-deriving instance RealFrac NominalDiffTime-#endif {-# INLINE microNominalDiffTime #-} microNominalDiffTime :: Iso' Int64 NominalDiffTime
src/Data/Thyme/Time.hs view
@@ -1,10 +1,14 @@-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} --- | This module provides compatibility wrappers for the things that @thyme@--- does differently from @time@, and allows it to be used as a drop-in--- replacement for the latter, with the exceptions noted below:+-- | This module provides compatibility instances and wrappers for the+-- things that @thyme@ does differently from @time@, and allows it to be+-- used as a drop-in replacement for the latter, with the exceptions noted+-- below: -- -- * When constructing an 'UTCTime' or 'UniversalTime', use 'mkUTCTime' or -- 'mkModJulianDate' in place of @UTCTime@ or @ModJulianDate@.@@ -46,6 +50,50 @@ import qualified Data.Time.Clock.TAI as T import qualified Data.Time.LocalTime as T +instance Num Micro where+ {-# INLINE (+) #-}+ {-# INLINE (-) #-}+ {-# INLINE (*) #-}+ {-# INLINE negate #-}+ {-# INLINE abs #-}+ {-# INLINE signum #-}+ {-# INLINE fromInteger #-}+ Micro a + Micro b = Micro (a + b)+ Micro a - Micro b = Micro (a - b)+ Micro a * Micro b = Micro (quot a 1000 * quot b 1000)+ negate (Micro a) = Micro (negate a)+ abs (Micro a) = Micro (abs a)+ signum (Micro a) = Micro (signum a * 1000000)+ fromInteger a = Micro (fromInteger a * 1000000)++instance Real Micro where+ {-# INLINE toRational #-}+ toRational (Micro a) = toInteger a % 1000000++instance Fractional Micro where+ {-# INLINE (/) #-}+ {-# INLINE recip #-}+ {-# INLINE fromRational #-}+ Micro a / Micro b = Micro (quot (a * 1000) (b * 1000))+ recip (Micro a) = Micro (quot 1000000 a)+ fromRational = toMicro++instance RealFrac Micro where+ {-# INLINE properFraction #-}+ properFraction a = (fromIntegral q, r) where+ (q, r) = microQuotRem a (Micro 1000000)++deriving instance Num DiffTime+deriving instance Real DiffTime+deriving instance Fractional DiffTime+deriving instance RealFrac DiffTime++deriving instance Num NominalDiffTime+deriving instance Real NominalDiffTime+deriving instance Fractional NominalDiffTime+deriving instance RealFrac NominalDiffTime++------------------------------------------------------------------------ -- * Type conversion class Thyme a b | b -> a where
+ tests/Common.hs view
@@ -0,0 +1,70 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Common where++import Prelude+import Control.Applicative+import Control.Lens+import Data.Basis+import Data.Thyme+import Data.VectorSpace+import System.Exit+import Test.QuickCheck+import qualified Test.QuickCheck.Gen as Gen++exit :: Bool -> IO ()+exit b = exitWith $ if b then ExitSuccess else ExitFailure 1++------------------------------------------------------------------------++instance Arbitrary Day where+ arbitrary = fmap (review gregorian) $ YearMonthDay+ -- FIXME: We disagree with time on how many digits to use for year.+ <$> choose (1000, 9999) <*> choose (1, 12) <*> choose (1, 31)++instance Arbitrary DiffTime where+ arbitrary = (^*) (basisValue ()) . toRational <$> (choose (0, 86400.999999) :: Gen Double)++instance Arbitrary UTCTime where+ arbitrary = fmap (review utcTime) $ UTCTime <$> arbitrary <*> arbitrary++------------------------------------------------------------------------++newtype Spec = Spec String deriving (Show)++instance Arbitrary Spec where+ arbitrary = do+ -- Pick a non-overlapping day spec generator.+ day <- Gen.elements+ [ spec {-YearMonthDay-}"DFYyCBbhmde"+ , spec {-OrdinalDate-}"YyCj"+ -- TODO: time only consider the presence of %V as+ -- indication that it should parse as WeekDate+ , (++) "%V " <$> spec {-WeekDate-}"GgfuwAa"+ , spec {-SundayWeek-}"YyCUuwAa"+ , spec {-MondayWeek-}"YyCWuwAa"+ ] :: Gen (Gen String)+ -- Pick a non-overlapping day & tod spec generator.+ time <- Gen.frequency+ [ (16, pure $ Gen.frequency+ [ (8, day)+ , (4, rod)+ , (2, h12)+ , (1, sec)+ , (1, spec {-TimeZone-}"zZ")+ ] )+ -- TODO: these are broken due to issues above and below+ -- , (2, pure $ spec {-aggregate-}"crXx")+ , (1, pure $ spec {-UTCTime-}"s")+ ] :: Gen (Gen String)+ fmap (Spec . unwords) . listOf1 $ frequency+ [(16, time), (4, string), (1, pure "%%")]+ where+ spec = Gen.elements . fmap (\ c -> ['%', c])+ string = filter ('%' /=) <$> arbitrary+ -- TODO: time discards %q %Q or %p %P after setting %S or hours+ -- respectively. Fudge it by always including %q and %p at end.+ -- tod = spec {-TimeOfDay-}"RTPpHIklMSqQ"+ rod = spec {-RestOfDay-}"RHkMqQ"+ sec = (++ " %q") <$> spec {-seconds-}"ST"+ h12 = (++ " %p") <$> spec {-12-hour-}"Il"+
+ tests/bench.hs view
@@ -0,0 +1,129 @@+import Prelude+import Control.Arrow+import Control.Applicative+import Control.Lens+import Control.Monad+import Control.Monad.IO.Class+import Criterion+import Criterion.Analysis+import Criterion.Config+import Criterion.Environment+import Criterion.Monad+import Data.Basis+import Data.Monoid+import Data.Thyme+import Data.Thyme.Calendar.OrdinalDate+import Data.Thyme.Calendar.MonthDay+import Data.Thyme.Time+import qualified Data.Time as T+import qualified Data.Time.Calendar.OrdinalDate as T+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 Data.VectorSpace+import Test.QuickCheck as QC+import Test.QuickCheck.Gen as QC+import System.Locale++import System.Random+import Text.Printf++import Common++main :: IO ()+main = do+ utcs <- unGen (vectorOf samples arbitrary) <$> newStdGen <*> pure 0+ let utcs' = review thyme <$> (utcs :: [UTCTime])+ now <- getCurrentTime+ let now' = review thyme now+ let strs = T.formatTime defaultTimeLocale spec <$> utcs'+ let dt = 86405 *^ basisValue ()+ let dt' = review thyme dt+ let days = utctDay . unUTCTime <$> utcs+ let days' = T.utctDay <$> utcs'+ let mons = ((isLeapYear . ymdYear) &&& ymdMonth) . view gregorian <$> days+ let ords = ((isLeapYear . odYear) &&& odDay) . view ordinalDate <$> days++ let config = defaultConfig {cfgVerbosity = Last (Just Quiet)}+ (exit . and <=< withConfig config) $ do+ env <- measureEnvironment+ ns <- getConfigItem $ fromLJ cfgResamples+ mapM (benchMean env ns) $++ -- Calendar+ ( "addDays", 1.0+ , nf (addDays 28 <$>) days+ , nf (T.addDays 28 <$>) days' ) :++ ( "toOrdinalDate", 2.5+ , nf (toOrdinalDate <$>) days+ , nf (T.toOrdinalDate <$>) days' ) :++ ( "toGregorian", 3.5+ , nf (toGregorian <$>) days+ , nf (T.toGregorian <$>) days' ) :++ ( "showGregorian", 3.3+ , nf (showGregorian <$>) days+ , nf (T.showGregorian <$>) days' ) :++ ( "toWeekDate", 2.6+ , nf (toWeekDate <$>) days+ , nf (T.toWeekDate <$>) days' ) :++ ( "monthLength", 1.5+ , nf (uncurry monthLength <$>) mons+ , nf (uncurry T.monthLength <$>) mons ) :++ ( "dayOfYearToMonthAndDay", 2.2+ , nf (uncurry dayOfYearToMonthAndDay <$>) ords+ , nf (uncurry T.dayOfYearToMonthAndDay <$>) ords ) :++ -- Clock+ ( "addUTCTime", 85+ , nf (addUTCTime dt <$>) utcs+ , nf (T.addUTCTime dt' <$>) utcs' ) :++ ( "diffUTCTime", 21+ , nf (diffUTCTime now <$>) utcs+ , nf (T.diffUTCTime now' <$>) utcs' ) :++ ( "utcTimeToPOSIXSeconds", 10+ , nf (utcTimeToPOSIXSeconds <$>) utcs+ , nf (T.utcTimeToPOSIXSeconds <$>) utcs' ) :++ -- LocalTime+ ( "timeToTimeOfDay", 70+ , nf (timeToTimeOfDay <$>) (utctDayTime . unUTCTime <$> utcs)+ , nf (T.timeToTimeOfDay <$>) (T.utctDayTime <$> utcs') ) :++ ( "utcToLocalTime", 30+ , nf (utcToLocalTime utc <$>) utcs+ , nf (T.utcToLocalTime T.utc <$>) utcs' ) :++ -- Format+ ( "formatTime", 9+ , nf (formatTime defaultTimeLocale spec <$>) utcs+ , nf (T.formatTime defaultTimeLocale spec <$>) utcs' ) :++ ( "parseTime", 4.5+ , nf (parse <$>) strs+ , nf (parse' <$>) strs ) :++ []++ where+ samples = 32+ spec = "%F %G %V %u %j %T %s"+ parse = parseTime defaultTimeLocale spec :: String -> Maybe UTCTime+ parse' = T.parseTime defaultTimeLocale spec :: String -> Maybe T.UTCTime++ benchMean env n (name, expected, us, them) = do+ ours <- flip analyseMean n =<< runBenchmark env us+ theirs <- flip analyseMean n =<< runBenchmark env them+ let ratio = theirs / ours+ liftIO . void $ printf "%-23s: %6.1fns, %5.1f×; expected %4.1f× : %s\n"+ name (ours * 1000000000 / fromIntegral samples) ratio expected+ (if ratio >= expected then "OK." else "oh noes. D:")+ return (ratio >= expected)+
tests/sanity.hs view
@@ -1,34 +1,19 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-}-{-# OPTIONS_GHC -fno-warn-orphans #-} import Prelude-import Control.Applicative import Control.Lens import Control.Monad-import Control.Monad.IO.Class-import Criterion-import Criterion.Analysis-import Criterion.Config-import Criterion.Environment-import Criterion.Monad import qualified Data.Attoparsec.ByteString.Char8 as P-import Data.Basis import Data.ByteString (ByteString)-import Data.Monoid import Data.Thyme import Data.Thyme.Time import qualified Data.Time as T-import Data.VectorSpace-import System.Exit import System.Locale-import System.Random import Test.QuickCheck-import qualified Test.QuickCheck.Gen as Gen-import Text.Printf +import Common+ #if MIN_VERSION_bytestring(0,10,0) # if MIN_VERSION_bytestring(0,10,2) import qualified Data.ByteString.Builder as B@@ -51,60 +36,6 @@ ------------------------------------------------------------------------ -instance Arbitrary Day where- arbitrary = fmap (review gregorian) $ YearMonthDay- -- FIXME: We disagree with time on how many digits to use for year.- <$> choose (1000, 9999) <*> choose (1, 12) <*> choose (1, 31)--instance Arbitrary DiffTime where- arbitrary = (^*) (basisValue ()) . toRational <$> (choose (0, 86400.999999) :: Gen Double)--instance Arbitrary UTCTime where- arbitrary = fmap (review utcTime) $ UTCTime <$> arbitrary <*> arbitrary----------------------------------------------------------------------------newtype Spec = Spec String deriving (Show)--instance Arbitrary Spec where- arbitrary = do- -- Pick a non-overlapping day spec generator.- day <- Gen.elements- [ spec {-YearMonthDay-}"DFYyCBbhmde"- , spec {-OrdinalDate-}"YyCj"- -- TODO: time only consider the presence of %V as- -- indication that it should parse as WeekDate- , (++) "%V " <$> spec {-WeekDate-}"GgfuwAa"- , spec {-SundayWeek-}"YyCUuwAa"- , spec {-MondayWeek-}"YyCWuwAa"- ] :: Gen (Gen String)- -- Pick a non-overlapping day & tod spec generator.- time <- Gen.frequency- [ (16, pure $ Gen.frequency- [ (8, day)- , (4, rod)- , (2, h12)- , (1, sec)- , (1, spec {-TimeZone-}"zZ")- ] )- -- TODO: these are broken due to issues above and below- -- , (2, pure $ spec {-aggregate-}"crXx")- , (1, pure $ spec {-UTCTime-}"s")- ] :: Gen (Gen String)- fmap (Spec . unwords) . listOf1 $ frequency- [(16, time), (4, string), (1, pure "%%")]- where- spec = Gen.elements . fmap (\ c -> ['%', c])- string = filter ('%' /=) <$> arbitrary- -- TODO: time discards %q %Q or %p %P after setting %S or hours- -- respectively. Fudge it by always including %q and %p at end.- -- tod = spec {-TimeOfDay-}"RTPpHIklMSqQ"- rod = spec {-RestOfDay-}"RHkMqQ"- sec = (++ " %q") <$> spec {-seconds-}"ST"- h12 = (++ " %p") <$> spec {-12-hour-}"Il"--------------------------------------------------------------------------- prop_formatTime :: Spec -> UTCTime -> Property prop_formatTime (Spec spec) t@(review thyme -> t') = printTestCase desc (s == s') where@@ -125,39 +56,10 @@ ------------------------------------------------------------------------ main :: IO ()-main = do- correct <- fmap (all isSuccess) . mapM quickCheckResult $+main = (exit . all isSuccess <=< mapM quickCheckResult) $ prop_formatTime : prop_parseTime : []-- ts <- Gen.unGen (vectorOf 10 arbitrary) <$> newStdGen <*> pure 0- let ts' = review thyme <$> (ts :: [UTCTime])- let ss = T.formatTime defaultTimeLocale spec <$> ts'- fast <- fmap and . withConfig config $ do- env <- measureEnvironment- ns <- getConfigItem $ fromLJ cfgResamples- mapM (benchMean env ns) $- ( "formatTime", 9- , nf (formatTime defaultTimeLocale spec <$>) ts- , nf (T.formatTime defaultTimeLocale spec <$>) ts' ) :- ( "parseTime", 4.5, nf (parse <$>) ss, nf (parse' <$>) ss ) :- []-- exitWith $ if correct && fast then ExitSuccess else ExitFailure 1 where isSuccess r = case r of Success {} -> True; _ -> False- config = defaultConfig {cfgVerbosity = Last (Just Quiet)}-- spec = "%F %G %V %u %j %T %s"- parse = parseTime defaultTimeLocale spec :: String -> Maybe UTCTime- parse' = T.parseTime defaultTimeLocale spec :: String -> Maybe T.UTCTime-- benchMean env n (name, expected, us, them) = do- ours <- flip analyseMean n =<< runBenchmark env us- theirs <- flip analyseMean n =<< runBenchmark env them- let ratio = theirs / ours- liftIO . void $ printf- "%s: %.1f× faster; expected %.1f×.\n" name ratio expected- return (ratio >= expected)
thyme.cabal view
@@ -1,5 +1,5 @@ name: thyme-version: 0.2.2.0+version: 0.2.3.0 synopsis: A faster time library description: Thyme is a rewrite of the fine @time@ library, with a particular focus@@ -26,11 +26,6 @@ default: True manual: True -flag instance-num- description: instance Num (Nominal)DiffTime- default: True- manual: True- flag show-internal description: instance Show of internal representation default: False@@ -76,12 +71,11 @@ template-haskell >= 2.6, time >= 1.4, transformers,+ vector >= 0.9, vector-space >= 0.8 ghc-options: -Wall if flag(bug-for-bug) cpp-options: -DBUG_FOR_BUG=1- if flag(instance-num)- cpp-options: -DINSTANCE_NUM=1 if flag(show-internal) cpp-options: -DSHOW_INTERNAL=1 if flag(Werror)@@ -91,16 +85,32 @@ type: exitcode-stdio-1.0 hs-source-dirs: tests main-is: sanity.hs+ other-modules: Common build-depends: QuickCheck, attoparsec, base, bytestring,+ lens,+ old-locale,+ text,+ thyme,+ time,+ vector-space+ ghc-options: -Wall++benchmark bench+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: bench.hs+ other-modules: Common+ build-depends:+ QuickCheck,+ base, criterion, lens, old-locale, random,- text, thyme, time, transformers,