thyme 0.3.5.2 → 0.3.5.3
raw patch · 9 files changed
+130/−43 lines, 9 filesdep ~hlint
Dependency ranges changed: hlint
Files
- src/Data/Thyme/Calendar/Internal.hs +67/−14
- src/Data/Thyme/Clock/Internal.hs +5/−0
- src/Data/Thyme/Clock/POSIX.hsc +5/−3
- src/Data/Thyme/Format.hs +16/−0
- src/Data/Thyme/Time/Core.hs +8/−8
- tests/bench.hs +6/−1
- tests/hlint.hs +0/−2
- tests/sanity.hs +21/−13
- thyme.cabal +2/−2
src/Data/Thyme/Calendar/Internal.hs view
@@ -2,10 +2,12 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-}+#if SHOW_INTERNAL+{-# LANGUAGE StandaloneDeriving #-}+#endif {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-}@@ -121,29 +123,80 @@ instance NFData OrdinalDate +-- Brief description of the toOrdinal computation.+--+-- The length of the years in Gregorian calendar is periodic with+-- period of 400 years. There are 100 - 4 + 1 = 97 leap years in a+-- period, so the average length of a year is 365 + 97/400 =+-- 146097/400 days.+--+-- Now, if you consider these -- let's call them nominal -- years,+-- then for any point in time, for any linear day number we can+-- determine which nominal year does it fall into by a single+-- division. Moreover, if we align the start of the calendar year 1+-- with the start of the nominal year 1, then the calendar years and+-- nominal years never get too much out of sync. Specifically:+--+-- * start of the first day of a calendar year might fall into the+-- preceding nominal year, but never more than by 1.5 days (591/400+-- days, to be precise)+-- * the start of the last day of a calendar year always falls into+-- its nominal year (even for the leap years).+--+-- So, to find out the calendar year for a given day, we calculate+-- which nominal year does its start fall. And, if we are not too+-- close to the end of year, we have the right calendar+-- year. Othewise, we just check whether it falls within the next+-- calendar year.+--+-- Notes: to make the reasoning simpler and more efficient ('quot' is+-- faster than 'div') we do the computation directly only for positive+-- years (days after 1-1-1). For earlier dates we "transate" by an+-- integral number of 400 year periods, do the computation and+-- translate back.+ {-# INLINE ordinalDate #-} ordinalDate :: Iso' Day OrdinalDate ordinalDate = iso toOrd fromOrd where {-# INLINEABLE toOrd #-} toOrd :: Day -> OrdinalDate- toOrd (ModifiedJulianDay mjd) = OrdinalDate year yd where- -- pilfered- a = mjd + 678575- (quadcent, b) = divMod a 146097- cent = min (div b 36524) 3- c = b - cent * 36524- (quad, d) = divMod c 1461- y = min (div d 365) 3- yd = d - y * 365 + 1- year = quadcent * 400 + cent * 100 + quad * 4 + y + 1+ toOrd (ModifiedJulianDay mjd)+ | dayB0 <= 0 = case toOrdB0 dayInQC of+ OrdinalDate y yd -> OrdinalDate (y + quadCent * 400) yd+ | otherwise = toOrdB0 dayB0+ where+ dayB0 = mjd + 678575+ (quadCent, dayInQC) = dayB0 `divMod` 146097 + -- Input: days since 1-1-1. Precondition: has to be positive!+ {-# INLINE toOrdB0 #-}+ toOrdB0 :: Int -> OrdinalDate+ toOrdB0 dayB0 = res+ where+ (y0, r) = (400 * dayB0) `quotRem` 146097+ d0 = dayInYear y0 dayB0+ d1 = dayInYear (y0 + 1) dayB0+ res = if r > 146097 - 600 && d1 > 0+ then OrdinalDate (y0 + 1 + 1) d1+ else OrdinalDate (y0 + 1) d0++ -- Input: (year - 1) (day as days since 1-1-1)+ -- Precondition: year is positive!+ {-# INLINE dayInYear #-}+ dayInYear :: Int -> Int -> Int+ dayInYear y0 dayB0 = dayB0 - 365 * y0 - leaps + 1+ where+ leaps = y0 `shiftR` 2 - centuries + centuries `shiftR` 2+ centuries = y0 `quot` 100+ {-# INLINEABLE fromOrd #-} fromOrd :: OrdinalDate -> Day fromOrd (OrdinalDate year yd) = ModifiedJulianDay mjd where- -- pilfered- y = year - 1- mjd = 365 * y + div y 4 - div y 100 + div y 400 - 678576+ years = year - 1+ centuries = years `div` 100+ leaps = years `shiftR` 2 - centuries + centuries `shiftR` 2+ mjd = 365 * years + leaps - 678576 + clip 1 (if isLeapYear year then 366 else 365) yd clip a b = max a . min b
src/Data/Thyme/Clock/Internal.hs view
@@ -74,6 +74,11 @@ fromSeconds' :: (TimeDiff t) => Rational -> t fromSeconds' = (*^ basisValue ()) +{-# INLINE picoseconds #-}+picoseconds :: (TimeDiff t) => Iso' t Integer+picoseconds = microseconds . iso ((*) 1000000 . toInteger)+ (\ ps -> fromInteger $ quot (ps + signum ps * 500000) 1000000)+ ------------------------------------------------------------------------ -- not for public consumption
src/Data/Thyme/Clock/POSIX.hsc view
@@ -6,7 +6,9 @@ module Data.Thyme.Clock.POSIX ( posixDayLength- , module Data.Thyme.Clock.POSIX+ , POSIXTime+ , posixTime+ , getPOSIXTime ) where import Prelude@@ -14,7 +16,6 @@ import Data.AdditiveGroup import Data.Thyme.Internal.Micro import Data.Thyme.Clock.Internal-import Data.VectorSpace #ifdef mingw32_HOST_OS import System.Win32.Time@@ -32,7 +33,8 @@ posixTime :: Iso' UTCTime POSIXTime posixTime = iso (\ (UTCRep t) -> t ^-^ unixEpoch) (UTCRep . (^+^) unixEpoch) where- unixEpoch = {-ModifiedJulianDay-}40587 *^ posixDayLength+ unixEpoch = review microseconds $+ {-ModifiedJulianDay-}40587 * {-posixDayLength-}86400000000 {-# INLINE getPOSIXTime #-} getPOSIXTime :: IO POSIXTime
src/Data/Thyme/Format.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-orphans #-} #include "thyme.h"@@ -18,6 +19,9 @@ import Prelude import Control.Applicative+#if SHOW_INTERNAL+import Control.Arrow+#endif import Control.Lens import Control.Monad.Trans import Control.Monad.State.Strict@@ -483,6 +487,17 @@ ------------------------------------------------------------------------ +deriving instance Read UTCView+#if SHOW_INTERNAL+deriving instance Read Day+deriving instance Read TimeOfDay+deriving instance Read LocalTime+deriving instance Read ZonedTime+deriving instance Read TimeZone+instance Read UTCTime where+ {-# INLINE readsPrec #-}+ readsPrec n = fmap (first $ review utcTime) . readsPrec n+#else instance Read Day where {-# INLINEABLE readsPrec #-} readsPrec _ = readParen False $@@ -507,6 +522,7 @@ {-# INLINEABLE readsPrec #-} readsPrec _ = readParen False $ readsTime defaultTimeLocale "%Y-%m-%d %H:%M:%S%Q %Z"+#endif ------------------------------------------------------------------------
src/Data/Thyme/Time/Core.hs view
@@ -29,6 +29,7 @@ import qualified Data.Time.Clock as T import qualified Data.Time.Clock.TAI as T import qualified Data.Time.LocalTime as T+import Unsafe.Coerce ------------------------------------------------------------------------ -- * Type conversion@@ -48,9 +49,12 @@ instance Thyme T.DiffTime DiffTime where {-# INLINE thyme #-}- thyme = iso (round . (*) 1000000)- (T.picosecondsToDiffTime . (*) 1000000 . toInteger) . from microseconds+ thyme = iso unsafeCoerce unsafeCoerce . from picoseconds +instance Thyme T.NominalDiffTime NominalDiffTime where+ {-# INLINE thyme #-}+ thyme = iso unsafeCoerce unsafeCoerce . from picoseconds+ instance Thyme T.UTCTime UTCView where {-# INLINE thyme #-} thyme = iso@@ -61,11 +65,6 @@ {-# INLINE thyme #-} thyme = thyme . from utcTime -instance Thyme T.NominalDiffTime NominalDiffTime where- {-# INLINE thyme #-}- thyme = iso (round . (*) 1000000) -- no picosecondsToNominalDiffTime D:- (fromRational . (% 1000000) . toInteger) . from microseconds- instance Thyme T.AbsoluteTime AbsoluteTime where {-# INLINE thyme #-} thyme = iso (`T.diffAbsoluteTime` T.taiEpoch)@@ -234,7 +233,8 @@ {-# INLINE picosecondsToDiffTime #-} picosecondsToDiffTime :: Int64 -> DiffTime-picosecondsToDiffTime a = DiffTime (Micro $ div (a + 500000) 1000000)+picosecondsToDiffTime a = DiffTime . Micro $+ quot (a + signum a * 500000) 1000000 {-# INLINE mkUTCTime #-} mkUTCTime :: Day -> DiffTime -> UTCTime
tests/bench.hs view
@@ -61,6 +61,8 @@ let years = view (gregorian . _ymdYear) <$> days let years' = (\ (y, _m, _d) -> y) . T.toGregorian <$> days' let mons = ((isLeapYear . ymdYear) &&& ymdMonth) . view gregorian <$> days+ let yyds = (odYear &&& odDay) . view ordinalDate <$> days+ let yyds' = ((fromIntegral . odYear) &&& odDay) . view ordinalDate <$> days let ords = ((isLeapYear . odYear) &&& odDay) . view ordinalDate <$> days let pxs = utcTimeToPOSIXSeconds <$> utcs let pxs' = T.utcTimeToPOSIXSeconds <$> utcs'@@ -80,6 +82,10 @@ , nf (toOrdinalDate <$>) days , nf (T.toOrdinalDate <$>) days' ) : + ( "fromOrdinalDate", 2.0+ , nf (uncurry fromOrdinalDate <$>) yyds+ , nf (uncurry T.fromOrdinalDate <$>) yyds' ) :+ ( "toGregorian", 4.3 , nf (toGregorian <$>) days , nf (T.toGregorian <$>) days' ) :@@ -158,4 +164,3 @@ ratio expected ((ratio / expected - 1) * 100) (if ratio >= expected then "OK." else "oh noes. D:") return (ratio >= expected)-
tests/hlint.hs view
@@ -11,8 +11,6 @@ , "--cpp-include=include" , "--cpp-include=dist/build/autogen" , "--cpp-define=SHOW_INTERNAL=1"- , "-XNoUnboxedTuples"- , "-i", "Unused LANGUAGE pragma" , "-i", "Reduce duplication" , "-i", "Redundant lambda" , "-i", "Use if"
tests/sanity.hs view
@@ -6,13 +6,14 @@ #endif import Prelude+import Control.Arrow import Control.Lens-import Control.Monad import qualified Data.Attoparsec.ByteString.Char8 as P import Data.ByteString (ByteString) import Data.Thyme import Data.Thyme.Time import qualified Data.Time as T+import qualified Data.Time.Calendar.OrdinalDate as T import System.Locale import Test.QuickCheck @@ -40,6 +41,13 @@ ------------------------------------------------------------------------ +prop_ShowRead :: (Eq a, Show a, Read a) => a -> Bool+prop_ShowRead a = (a, "") `elem` reads (show a)++prop_toOrdinalDate :: Day -> Bool+prop_toOrdinalDate day =+ fromIntegral `first` toOrdinalDate day == T.toOrdinalDate (thyme # day)+ prop_formatTime :: Spec -> RecentTime -> Property prop_formatTime (Spec spec) (RecentTime t@(review thyme -> t')) #if MIN_VERSION_QuickCheck(2,7,0)@@ -65,21 +73,21 @@ desc = "input: " ++ show s ++ "\nthyme: " ++ show t ++ "\ntime: " ++ show t' ++ "\nstate: " ++ show (tp s) -prop_ShowRead :: (Eq a, Show a, Read a) => a -> Bool-prop_ShowRead a = (a, "") `elem` reads (show a)- ------------------------------------------------------------------------ {-# ANN main "HLint: ignore Use list literal" #-} main :: IO ()-main = (exit . all isSuccess <=< sequence) $- quickCheckResult (prop_ShowRead :: Day -> Bool) :- quickCheckResult (prop_ShowRead :: DiffTime -> Bool) :- quickCheckResult (prop_ShowRead :: NominalDiffTime -> Bool) :- quickCheckResult (prop_ShowRead :: UTCTime -> Bool) :- quickCheckResult prop_formatTime :- quickCheckResult prop_parseTime :- []- where+main = exit . all isSuccess =<< sequence+ [ qc 10000 (prop_ShowRead :: Day -> Bool)+ , qc 10000 (prop_ShowRead :: DiffTime -> Bool)+ , qc 10000 (prop_ShowRead :: NominalDiffTime -> Bool)+ , qc 10000 (prop_ShowRead :: UTCTime -> Bool)+ , qc 10000 prop_toOrdinalDate+ , qc 1000 prop_formatTime+ , qc 1000 prop_parseTime++ ] where isSuccess r = case r of Success {} -> True; _ -> False+ qc :: Testable prop => Int -> prop -> IO Result+ qc n = quickCheckWithResult stdArgs {maxSuccess = n, maxSize = n}
thyme.cabal view
@@ -1,5 +1,5 @@ name: thyme-version: 0.3.5.2+version: 0.3.5.3 synopsis: A faster time library description: Thyme is a rewrite of the fine @time@ library, with a particular focus@@ -160,7 +160,7 @@ ghc-options: -threaded -rtsopts -with-rtsopts=-N hs-source-dirs: tests if flag(HLint)- build-depends: base, hlint >= 1.8.59+ build-depends: base, hlint >= 1.9 else buildable: False