packages feed

thyme 0.3.0.1 → 0.3.0.2

raw patch · 17 files changed

+230/−13 lines, 17 filesdep +ghc-primdep +hlintdep ~base

Dependencies added: ghc-prim, hlint

Dependency ranges changed: base

Files

include/thyme.h view
@@ -1,3 +1,3 @@-#define INSTANCES_USUAL     Eq, Ord, Data, Typeable+#define INSTANCES_USUAL     Eq, Ord, Data, Typeable, Generic #define INSTANCES_NEWTYPE   INSTANCES_USUAL, Enum, Ix, NFData #define INSTANCES_MICRO     INSTANCES_NEWTYPE, Bounded, Random, Arbitrary
src/Data/Micro.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-}@@ -18,6 +19,7 @@ import Data.Ix import Data.Ratio import Data.VectorSpace+import GHC.Generics (Generic) import System.Random import Test.QuickCheck
src/Data/Thyme/Calendar.hs view
@@ -72,6 +72,7 @@         $ min (gregorianMonthLength y' m') d where     ((+) y -> y', (+) 1 -> m') = divMod (m + n - 1) 12 +{-# ANN gregorianMonthsRollover "HLint: ignore Use if" #-} {-# INLINEABLE gregorianMonthsRollover #-} gregorianMonthsRollover :: Months -> YearMonthDay -> YearMonthDay gregorianMonthsRollover n (YearMonthDay y m d) = case d <= len of
src/Data/Thyme/Calendar/Internal.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-}@@ -22,6 +23,7 @@ import Data.Thyme.Format.Internal import Data.Vector.Unboxed (Vector) import qualified Data.Vector.Unboxed as V+import GHC.Generics (Generic) import System.Random import Test.QuickCheck @@ -145,6 +147,7 @@ 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 +{-# ANN monthDays "HLint: ignore Use fromMaybe" #-} {-# NOINLINE monthDays #-} monthDays :: Vector ({-Month-}Int8, {-DayOfMonth-}Int8) monthDays = V.generate 365 go where@@ -153,6 +156,7 @@         m = maybe 12 id $ V.findIndex (yd <) first         d = succ yd - V.unsafeIndex first (pred m) +{-# ANN monthDaysLeap "HLint: ignore Use fromMaybe" #-} {-# NOINLINE monthDaysLeap #-} monthDaysLeap :: Vector ({-Month-}Int8, {-DayOfMonth-}Int8) monthDaysLeap = V.generate 366 go where
+ src/Data/Thyme/Calendar/Julian.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}++#include "thyme.h"++-- | Proleptic Julian Dates+module Data.Thyme.Calendar.Julian+    ( OrdinalDate (..), Year, DayOfYear+    , module Data.Thyme.Calendar.Julian+    , _odYear, _odDay+    ) where++import Prelude+import Control.Applicative+{- import Control.DeepSeq -}+import Control.Monad+import Control.Lens+{- import Data.Data -}+import Data.Thyme.Calendar+import Data.Thyme.Calendar.Internal+import Data.Thyme.Calendar.OrdinalDate+{- import Data.Thyme.TH -}+{- import System.Random -}+{- import Test.QuickCheck -}++{-# INLINE julianOrdinal #-}+julianOrdinal :: Iso' Day OrdinalDate+julianOrdinal = iso toOrdinal fromOrdinal where++    {-# INLINEABLE toOrdinal #-}+    toOrdinal :: Day -> OrdinalDate+    toOrdinal (ModifiedJulianDay mjd) = OrdinalDate {..} where+        (quad, d) = divMod (mjd + 678577) 1461+        yoff = min (div d 365) 3+        odDay = d - (yoff * 365) + 1+        odYear = quad * 4 + yoff + 1++    {-# INLINEABLE fromOrdinal #-}+    fromOrdinal :: OrdinalDate -> Day+    fromOrdinal OrdinalDate {..} = ModifiedJulianDay mjd where+        yd = clip 1 (if isJulianLeapYear odYear then 366 else 365) odDay+        clip a b = max a . min b+        y = odYear - 1+        mjd = yd + 365 * y + div y 4 - 678578++{-# INLINEABLE julianOrdinalValid #-}+julianOrdinalValid :: OrdinalDate -> Maybe Day+julianOrdinalValid OrdinalDate {..} = ModifiedJulianDay mjd+        <$ guard (1 <= odDay && odDay <= lastDay) where+    lastDay = if isJulianLeapYear odYear then 366 else 365+    y = odYear - 1+    mjd = odDay + 365 * y + div y 4 - 678578++{-# INLINE isJulianLeapYear #-}+isJulianLeapYear :: Year -> Bool+isJulianLeapYear y = mod y 4 == 0++------------------------------------------------------------------------++{-# INLINE julianYearMonthDay #-}+julianYearMonthDay :: Iso' OrdinalDate YearMonthDay+julianYearMonthDay = iso fromOrdinal toOrdinal where++    {-# INLINEABLE fromOrdinal #-}+    fromOrdinal :: OrdinalDate -> YearMonthDay+    fromOrdinal OrdinalDate {..} = YearMonthDay odYear m d where+        MonthDay m d = odDay ^. monthDay (isJulianLeapYear odYear)++    {-# INLINEABLE toOrdinal #-}+    toOrdinal :: YearMonthDay -> OrdinalDate+    toOrdinal YearMonthDay {..} = OrdinalDate ymdYear yd where+        yd = monthDay (isJulianLeapYear ymdYear) # MonthDay ymdMonth ymdDay++{-# INLINE julianYearMonthDayValid #-}+julianYearMonthDayValid :: YearMonthDay -> Maybe OrdinalDate+julianYearMonthDayValid YearMonthDay {..} = OrdinalDate ymdYear+    <$> monthDayValid (isJulianLeapYear ymdYear) (MonthDay ymdMonth ymdDay)++------------------------------------------------------------------------++{-# INLINE julian #-}+julian :: Iso' Day YearMonthDay+julian = julianOrdinal . julianYearMonthDay++{-# INLINE julianValid #-}+julianValid :: YearMonthDay -> Maybe Day+julianValid ymd = review julianOrdinal <$> julianYearMonthDayValid ymd+
src/Data/Thyme/Calendar/WeekdayOfMonth.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-} @@ -17,6 +18,7 @@ import Data.Thyme.Calendar import Data.Thyme.Calendar.Internal import Data.Thyme.TH+import GHC.Generics (Generic) import System.Random import Test.QuickCheck @@ -49,7 +51,7 @@     toWeekday day@(view ordinalDate -> ord) = WeekdayOfMonth y m n wd where         YearMonthDay y m d = ord ^. yearMonthDay         WeekDate _ _ wd = toWeekOrdinal ord day-        n = div (d - 1) 7+        n = 1 + div (d - 1) 7      {-# INLINEABLE fromWeekday #-}     fromWeekday :: WeekdayOfMonth -> Day@@ -76,4 +78,3 @@  -- * Lenses thymeLenses ''WeekdayOfMonth-
src/Data/Thyme/Clock.hs view
@@ -1,4 +1,11 @@--- | 'Num', 'Real', 'Fractional' and 'RealFrac' instances for 'DiffTime' and+-- | Types and functions for+-- <http://en.wikipedia.org/wiki/Coordinated_Universal_Time UTC> and+-- <http://en.wikipedia.org/wiki/Universal_Time#Versions UT1>.+--+-- If you don't care about leap seconds, keep to 'UTCTime' and+-- 'NominalDiffTime' for your clock calculations, and you'll be fine.+--+-- 'Num', 'Real', 'Fractional' and 'RealFrac' instances for 'DiffTime' and -- 'NominalDiffTime' are only available by importing "Data.Thyme.Time". In -- their stead are instances of 'Data.AdditiveGroup.AdditiveGroup', -- 'Data.Basis.HasBasis' and 'Data.VectorSpace.VectorSpace', with@@ -43,6 +50,7 @@ import Data.Thyme.Clock.Internal import Data.Thyme.Clock.POSIX +-- | Get the current UTC time from the system clock. getCurrentTime :: IO UTCTime getCurrentTime = fmap (review posixTime) getPOSIXTime
src/Data/Thyme/Clock/Internal.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} -- workaround {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-}@@ -23,6 +24,7 @@ import Data.Micro import Data.Thyme.Calendar.Internal import Data.VectorSpace+import GHC.Generics (Generic) import System.Random import Test.QuickCheck @@ -33,22 +35,23 @@ import Text.Read (readPrec) #endif --- | Time differences, encompassing both 'DiffTime' and 'NominalDiffTime'.+-- | Time intervals, encompassing both 'DiffTime' and 'NominalDiffTime'. ----- FIXME: still affected by <http://hackage.haskell.org/trac/ghc/ticket/7611>?+-- [@Issues@] Still affected by+-- <http://hackage.haskell.org/trac/ghc/ticket/7611>? class (HasBasis t, Basis t ~ (), Scalar t ~ Rational) => TimeDiff t where     -- | Escape hatch; avoid.     microseconds :: Iso' t Int64 --- | Convert a time difference to some 'Fractional' type.+-- | Convert a time interval to some 'Fractional' type. {-# INLINE toSeconds #-} toSeconds :: (TimeDiff t, Fractional n) => t -> n toSeconds = (* recip 1000000) . fromIntegral . view microseconds --- | Make a time difference from some 'Real' type.+-- | Make a time interval from some 'Real' type. ----- Where speed is a concern, make sure @n@ is one of 'Float', 'Double',--- 'Int', 'Int64' or 'Integer', for which @RULES@ have been provided.+-- [@Performance@] Try to make sure @n@ is one of 'Float', 'Double', 'Int',+-- 'Int64' or 'Integer', for which rewrite @RULES@ have been provided. {-# INLINE fromSeconds #-} fromSeconds :: (Real n, TimeDiff t) => n -> t fromSeconds = fromSeconds' . toRational@@ -84,6 +87,15 @@  ------------------------------------------------------------------------ +-- | An absolute time interval as measured by a clock.+--+-- 'DiffTime' forms an 'AdditiveGroup'―so can be added using '^+^' (or '^-^'+-- for subtraction), and also an instance of 'VectorSpace'―so can be scaled+-- using '*^', where+--+-- @+-- type 'Scalar' 'DiffTime' = 'Rational'+-- @ newtype DiffTime = DiffTime Micro deriving (INSTANCES_MICRO, AdditiveGroup)  #if SHOW_INTERNAL@@ -118,6 +130,20 @@  ------------------------------------------------------------------------ +-- | A time interval as measured by UTC, that does not take leap-seconds+-- into account.+--+-- For instance, the difference between @23:59:59@ and @00:00:01@ on the+-- following day is always 2 seconds of 'NominalDiffTime', regardless of+-- whether a leap-second took place.+--+-- 'NominalDiffTime' forms an 'AdditiveGroup'―so can be added using '^+^'+-- (or '^-^' for subtraction), and also an instance of 'VectorSpace'―so can+-- be scaled using '*^', where+--+-- @+-- type 'Scalar' 'NominalDiffTime' = 'Rational'+-- @ newtype NominalDiffTime = NominalDiffTime Micro deriving (INSTANCES_MICRO, AdditiveGroup)  #if SHOW_INTERNAL@@ -150,15 +176,26 @@     {-# INLINE microseconds #-}     microseconds = iso (\ (NominalDiffTime (Micro u)) -> u) (NominalDiffTime . Micro) +-- | The nominal length of a POSIX day: precisely 86400 SI seconds. {-# INLINE posixDayLength #-} posixDayLength :: NominalDiffTime posixDayLength = microseconds # 86400000000  ------------------------------------------------------------------------ --- Represented as a 'NominalDiffTime' since MJD epoch.+-- | The principal form of universal time, namely+-- <http://en.wikipedia.org/wiki/Universal_Time#Versions UT1>.+--+-- 'UniversalTime' is defined by the rotation of the Earth around its axis+-- relative to the Sun. Thus the length of a day by this definition varies+-- from one to the next, and is never exactly 86400 SI seconds unlike+-- <http://en.wikipedia.org/wiki/International_Atomic_Time TAI> or+-- 'AbsoluteTime'. The difference between UT1 and UTC is+-- <http://en.wikipedia.org/wiki/DUT1 DUT1>. newtype UniversalTime = UniversalRep NominalDiffTime deriving (INSTANCES_MICRO) +-- | View 'UniversalTime' as a fractional number of days since the+-- <http://en.wikipedia.org/wiki/Julian_day#Variants Modified Julian Date epoch>. {-# INLINE modJulianDate #-} modJulianDate :: Iso' UniversalTime Rational modJulianDate = iso@@ -167,9 +204,29 @@  ------------------------------------------------------------------------ --- Represented as a 'NominalDiffTime' since MJD epoch.+-- | <http://en.wikipedia.org/wiki/Coordinated_Universal_Time Coördinated universal time>:+-- the most common form of universal time for civil timekeeping. It is+-- synchronised with 'AbsoluteTime' and both tick in increments of SI+-- seconds, but UTC includes occasional leap-seconds so that it does not+-- drift too far from 'UniversalTime'.+--+-- 'UTCTime' is an instance of 'AffineSpace', with+--+-- @+-- type 'Diff' 'UTCTime' = 'NominalDiffTime'+-- @+--+-- Use '.+^' to add (or '.-^' to subtract) time intervals of type+-- 'NominalDiffTime', and '.-.' to get the interval between 'UTCTime's.+--+-- [@Performance@] Internally this is a 64-bit count of 'microseconds' since+-- the MJD epoch, so '.+^', '.-^' and '.-.' ought to be fairly fast.+--+-- [@Issues@] 'UTCTime' currently+-- <https://github.com/liyang/thyme/issues/3 cannot represent leap seconds>. newtype UTCTime = UTCRep NominalDiffTime deriving (INSTANCES_MICRO) +-- | Unpacked 'UTCTime', partly for compatibility with @time@. data UTCView = UTCTime     { utctDay :: {-# UNPACK #-}!Day     , utctDayTime :: {-# UNPACK #-}!DiffTime@@ -177,9 +234,11 @@  instance NFData UTCView +-- | 'Lens'' for the 'Day' component of an 'UTCTime'. _utctDay :: Lens' UTCTime Day _utctDay = utcTime . lens utctDay (\ (UTCTime _ t) d -> UTCTime d t) +-- | 'Lens'' for the time-of-day component of an 'UTCTime'. _utctDayTime :: Lens' UTCTime DiffTime _utctDayTime = utcTime . lens utctDayTime (\ (UTCTime d _) t -> UTCTime d t) @@ -190,6 +249,12 @@     {-# INLINE (.+^) #-}     UTCRep a .+^ d = UTCRep (a ^+^ d) +-- | View 'UTCTime' as an 'UTCView', comprising a 'Day' along with+-- a 'DiffTime' offset since midnight.+--+-- This is an improper lens: 'utctDayTime' offsets outside the range of+-- @['zeroV', 'posixDayLength')@ will carry over into the day part, with the+-- expected behaviour. {-# INLINE utcTime #-} utcTime :: Iso' UTCTime UTCView utcTime = iso toView fromView where
src/Data/Thyme/Clock/TAI.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-}@@ -41,6 +42,7 @@ import Data.Thyme.Format.Internal import Data.Thyme.LocalTime import Data.VectorSpace+import GHC.Generics (Generic) import System.Locale import System.Random (Random) import Test.QuickCheck
src/Data/Thyme/Format/Human.hs view
@@ -37,6 +37,7 @@ humanTimeDiff d = humanTimeDiffs d ""  -- | Display 'DiffTime' or 'NominalDiffTime' in a human-readable form.+{-# ANN humanTimeDiffs "HLint: ignore Use fromMaybe" #-} humanTimeDiffs :: (TimeDiff d) => d -> ShowS humanTimeDiffs td = (if signed < 0 then (:) '-' else id) . diff where     signed@(Micro . abs -> us) = td ^. microseconds
src/Data/Thyme/Format/Internal.hs view
@@ -41,6 +41,7 @@ shows02 :: Int -> ShowS shows02 n = if n < 10 then (:) '0' . shows n else shows n +{-# ANN shows_2 "HLint: ignore Use camelCase" #-} {-# INLINE shows_2 #-} shows_2 :: Int -> ShowS shows_2 n = if n < 10 then (:) ' ' . shows n else shows n
src/Data/Thyme/LocalTime/Internal.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StandaloneDeriving #-}@@ -27,6 +28,7 @@ #endif import Data.Thyme.LocalTime.TimeZone import Data.VectorSpace+import GHC.Generics (Generic) import System.Random import Test.QuickCheck
tests/bench.hs view
@@ -28,6 +28,7 @@  import Common +{-# ANN main "HLint: ignore Use list literal" #-} main :: IO () main = do     utcs <- unGen (vectorOf samples arbitrary) <$> newStdGen <*> pure 0
+ tests/hlint.hs view
@@ -0,0 +1,20 @@+module Main where++import Control.Monad+import Language.Haskell.HLint+import System.Exit++main :: IO ()+main = (`unless` exitFailure) . null =<< hlint+    [ "src", "tests"+    , "--cpp-define=HLINT"+    , "--cpp-include=include"+    , "--cpp-define=SHOW_INTERNAL=1"+    , "-XNoUnboxedTuples"+    , "-i", "Unused LANGUAGE pragma"+    , "-i", "Reduce duplication"+    , "-i", "Redundant lambda"+    , "-i", "Use if"+    , "-i", "Use import/export shortcut"+    ]+
tests/rewrite.hs view
@@ -31,6 +31,8 @@         [ "build", "--ghc-option=-ddump-rule-firings" ]     useless +{-# ANN hook ("HLint: ignore Evaluate" :: String) #-}+{-# ANN hook ("HLint: ignore Use if" :: String) #-} hook :: PackageDescription -> LocalBuildInfo -> UserHooks -> BuildFlags -> IO () hook pd lbi uh bf = do     -- more reliable way to force a rebuild?
tests/sanity.hs view
@@ -58,6 +58,7 @@  ------------------------------------------------------------------------ +{-# ANN main "HLint: ignore Use list literal" #-} main :: IO () main = (exit . all isSuccess <=< sequence) $         quickCheckResult (prop_ShowRead :: Day -> Bool) :
thyme.cabal view
@@ -1,5 +1,5 @@ name:           thyme-version:        0.3.0.1+version:        0.3.0.2 synopsis:       A faster time library description:     Thyme is a rewrite of the fine @time@ library, with a particular focus@@ -28,6 +28,11 @@     default: True     manual: True +flag HLint+    description: include HLint as a Cabal test-suite+    default: False+    manual: True+ flag show-internal     description: instance Show of internal representation     default: False@@ -44,6 +49,7 @@     exposed-modules:         Data.Thyme         Data.Thyme.Calendar+        Data.Thyme.Calendar.Julian         Data.Thyme.Calendar.MonthDay         Data.Thyme.Calendar.OrdinalDate         Data.Thyme.Calendar.WeekDate@@ -80,6 +86,8 @@         transformers,         vector >= 0.9,         vector-space >= 0.8+    if impl(ghc < 7.6.1)+        build-depends: ghc-prim     ghc-options: -Wall     if flag(bug-for-bug)         cpp-options: -DBUG_FOR_BUG=1@@ -121,6 +129,16 @@         text,         thyme     ghc-options: -Wall++test-suite hlint+    type: exitcode-stdio-1.0+    main-is: hlint.hs+    ghc-options: -threaded -rtsopts -with-rtsopts=-N+    hs-source-dirs: tests+    if flag(HLint)+        build-depends: base, hlint >= 1.8.53+    else+        buildable: False  benchmark bench     type: exitcode-stdio-1.0