packages feed

thyme 0.2.3.0 → 0.2.4.1

raw patch · 19 files changed

+626/−434 lines, 19 files

Files

src/Data/Micro.hs view
@@ -3,8 +3,8 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_HADDOCK hide #-} --- #hide module Data.Micro where  import Prelude@@ -35,14 +35,16 @@ deriving instance Read Micro #else instance Show Micro where+    {-# INLINEABLE showsPrec #-}     showsPrec _ (Micro a) = sign . shows si . frac where         sign = if a < 0 then (:) '-' else id-        (si, su) = quotRem (abs a) 1000000+        (si, su) = abs a `divMod` 1000000         frac = if su == 0 then id else (:) '.' . fills06 su . drops0 su  instance Read Micro where+    {-# INLINEABLE readPrec #-}     readPrec = lift $ do-        sign <- char '-' >> return negate `mplus` return id+        sign <- (char '-' >> return negate) `mplus` return id         s <- readS_to_P readDec         us <- (`mplus` return 0) $ do             _ <- char '.'@@ -84,8 +86,4 @@     decompose (Micro a) = [((), fromIntegral a % 1000000)]     {-# INLINE decompose' #-}     decompose' (Micro a) = const (fromIntegral a % 1000000)--{-# INLINE (^/^) #-}-(^/^) :: (HasBasis v, Basis v ~ (), Scalar v ~ s, Fractional s) => v -> v -> s-x ^/^ y = decompose' x () / decompose' y ()
src/Data/Thyme.hs view
@@ -4,11 +4,11 @@ -- 'Data.Int.Int64', which gives a usable range from @-290419-11-07 -- 19:59:05.224192 UTC@ to @294135-11-26 04:00:54.775807 UTC@ in the future. ----- Conversions are provided as 'Control.Lens.Iso''s from the @lens@ package,--- while 'Data.AdditiveGroup.AdditiveGroup', 'Data.VectorSpace.VectorSpace'--- and 'Data.AffineSpace.AffineSpace' from @vector-space@ allow for more--- principled calculations instead of 'Num', 'Fractional' & al. Check each--- module for usage examples, and see+-- Conversions are provided as 'Control.Lens.Iso.Iso''s from the @lens@+-- package, while 'Data.AdditiveGroup.AdditiveGroup',+-- 'Data.VectorSpace.VectorSpace' and 'Data.AffineSpace.AffineSpace' from+-- @vector-space@ allow for more principled calculations instead of 'Num',+-- 'Fractional' & al. Check each module for usage examples, and see -- <http://hackage.haskell.org/package/lens> or -- <http://hackage.haskell.org/package/vector-space> for further details. --
src/Data/Thyme/Calendar.hs view
@@ -50,7 +50,7 @@ {-# INLINEABLE showGregorian #-} showGregorian :: Day -> String showGregorian (view gregorian -> YearMonthDay y m d) =-    shows04 y . (:) '-' . shows02 m . (:) '-' . shows02 d $ ""+    showsYear y . (:) '-' . shows02 m . (:) '-' . shows02 d $ ""  #if SHOW_INTERNAL deriving instance Show Day
src/Data/Thyme/Calendar/Internal.hs view
@@ -3,8 +3,8 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_HADDOCK hide #-} --- #hide module Data.Thyme.Calendar.Internal where  import Prelude@@ -186,7 +186,7 @@ {-# INLINEABLE showWeekDate #-} showWeekDate :: Day -> String showWeekDate (view weekDate -> WeekDate y w d) =-    shows04 y . (++) "-W" . shows02 w . (:) '-' . shows d $ ""+    showsYear y . (++) "-W" . shows02 w . (:) '-' . shows d $ ""  ------------------------------------------------------------------------
src/Data/Thyme/Clock.hs view
@@ -1,27 +1,17 @@-{-# 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'' ()--- @+-- their stead are instances of 'Data.AdditiveGroup.AdditiveGroup',+-- 'Data.Basis.HasBasis' and 'Data.VectorSpace.VectorSpace', with+-- @'Data.VectorSpace.Scalar' 'DiffTime' ≡ 'Data.VectorSpace.Scalar'+-- 'NominalDiffTime' ≡ 'Rational'@. ----- Finally, write @n 'Data.VectorSpace.*^' 'Data.Basis.basisValue' ()@ where--- literals are expected.+--  Convert between time intervals and 'Rational's with 'seconds', or more+--  generally between any 'Real' or 'Fractional' using 'fromSeconds' and+--  'toSeconds'. If you must convert between 'DiffTime' and+--  'NominalDiffTime', compose 'microDiffTime' and 'microNominalDiffTime'. ----- 'UniversalTime' and 'UTCTime' are instances of--- 'Data.AffineSpace.AffineSpace', with @'Data.AffineSpace.Diff'--- 'UniversalTime' ≡ 'DiffTime'@, and @'Data.AffineSpace.Diff' 'UTCTime' ≡--- 'NominalDiffTime'@.+-- 'UTCTime' is an instance of 'Data.AffineSpace.AffineSpace', with+-- @'Data.AffineSpace.Diff' 'UTCTime' ≡ 'NominalDiffTime'@.  module Data.Thyme.Clock (     -- * Universal Time@@ -39,6 +29,11 @@     , microNominalDiffTime     , module Data.Thyme.Clock +    -- * Time interval conversion+    , seconds+    , toSeconds, fromSeconds+    , toSeconds', fromSeconds'+     -- * Lenses     , _utctDay, _utctDayTime     ) where@@ -47,18 +42,6 @@ import Control.Lens import Data.Thyme.Clock.Internal import Data.Thyme.Clock.POSIX-#if !SHOW_INTERNAL-import Data.Thyme.LocalTime.Internal-import Data.Thyme.LocalTime.TimeZone-#endif--#if SHOW_INTERNAL-instance Show UTCTime where-    showsPrec p = showsPrec p . view utcTime-#else-instance Show UTCTime where-    showsPrec p = showsPrec p . view zonedTime . (,) utc-#endif  getCurrentTime :: IO UTCTime getCurrentTime = fmap (review posixTime) getPOSIXTime
src/Data/Thyme/Clock/Internal.hs view
@@ -1,11 +1,12 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-} -- workaround {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_HADDOCK hide #-} --- #hide module Data.Thyme.Clock.Internal where  import Prelude@@ -28,6 +29,77 @@ import Text.Read (readPrec) #endif +-- | Workaround for GHC refusing to match RULES for functions with equality+-- constraints; see <http://hackage.haskell.org/trac/ghc/ticket/7611>.+class (HasBasis t, Basis t ~ ()) => TimeDiff t where+    microTimeDiff :: t -> Micro+instance TimeDiff DiffTime where microTimeDiff (DiffTime d) = d+instance TimeDiff NominalDiffTime where microTimeDiff (NominalDiffTime d) = d++-- | Time interval as a 'Rational' number of seconds. Compose with 'simple'+-- or 'simply' 'view' / 'review' to avoid ambiguous type variables.+{-# INLINE seconds #-}+seconds :: (HasBasis s, Basis s ~ (), HasBasis t, Basis t ~ ()) => Iso s t (Scalar s) (Scalar t)+seconds = iso (`decompose'` ()) (*^ basisValue ())++-- | Convert a time interval to some 'Fractional' type.+--+-- @+-- toSeconds :: (HasBasis s, Basis s ~ (), Scalar s ~ a, Real a, Fractional n) => s -> n+-- @+{-# INLINE toSeconds #-}+toSeconds :: (TimeDiff s, Real (Scalar s), Fractional n) => s -> n+toSeconds = realToFrac . simply view seconds++-- | Make a time interval from some 'Real' type. 'Rational'-avoiding rewrite+-- rules included for 'Double', 'Float', 'Integer', 'Int' and 'Int64'.+--+-- @+-- fromSeconds :: (HasBasis t, Basis t ~ (), Scalar t ~ b, Real n, Fractional b) => n -> t+-- @+{-# INLINE fromSeconds #-}+fromSeconds :: (TimeDiff t, Real n, Fractional (Scalar t)) => n -> t+fromSeconds = simply review seconds . realToFrac++-- | Type-restricted 'toSeconds' to avoid constraint-defaulting warnings.+{-# INLINE toSeconds' #-}+toSeconds' :: (HasBasis s, Basis s ~ ()) => s -> Scalar s+toSeconds' = simply view seconds++-- | Type-restricted 'fromSeconds' to avoid constraint-defaulting warnings.+{-# INLINE fromSeconds' #-}+fromSeconds' :: (HasBasis t, Basis t ~ ()) => Scalar t -> t+fromSeconds' = simply review seconds++{-# RULES++"toSeconds∷DiffTime→Fractional"+    toSeconds = (/ 1000000) . fromIntegral . review microDiffTime+"toSeconds∷NominalDiffTime→Fractional"+    toSeconds = (/ 1000000) . fromIntegral . review microNominalDiffTime++"fromSeconds∷Double→DiffTime"+    fromSeconds = view microDiffTime . round . (*) (1000000 :: Double)+"fromSeconds∷Double→NominalDiffTime"+    fromSeconds = view microNominalDiffTime . round . (*) (1000000 :: Double)++"fromSeconds∷Float→DiffTime"+    fromSeconds = view microDiffTime . round . (*) (1000000 :: Float)+"fromSeconds∷Float→NominalDiffTime"+    fromSeconds = view microNominalDiffTime . round . (*) (1000000 :: Float)++"fromSeconds∷Integer→{,Nominal}DiffTime"+    fromSeconds = fromSeconds . (fromInteger :: Integer -> Int64)+"fromSeconds∷Int→{,Nominal}DiffTime"+    fromSeconds = fromSeconds . (fromIntegral :: Int -> Int64)++"fromSeconds∷Int64→DiffTime"+    fromSeconds = view microDiffTime . (*) 1000000+"fromSeconds∷Int64→NominalDiffTime"+    fromSeconds = view microNominalDiffTime . (*) 1000000 #-}++------------------------------------------------------------------------+ newtype DiffTime = DiffTime Micro     deriving (Eq, Ord, Enum, Ix, Bounded, NFData, Data, Typeable, AdditiveGroup) @@ -36,8 +108,10 @@ deriving instance Read DiffTime #else instance Show DiffTime where+    {-# INLINEABLE showsPrec #-}     showsPrec p (DiffTime a) = showsPrec p a . (:) 's' instance Read DiffTime where+    {-# INLINEABLE readPrec #-}     readPrec = return (const . DiffTime) `ap` readPrec `ap` lift (char 's') #endif @@ -69,8 +143,10 @@ deriving instance Read NominalDiffTime #else instance Show NominalDiffTime where+    {-# INLINEABLE showsPrec #-}     showsPrec p (NominalDiffTime a) rest = showsPrec p a ('s' : rest) instance Read NominalDiffTime where+    {-# INLINEABLE readPrec #-}     readPrec = return (const . NominalDiffTime) `ap` readPrec `ap` lift (char 's') #endif @@ -104,8 +180,8 @@  {-# INLINE modJulianDate #-} modJulianDate :: Iso' UniversalTime Rational-modJulianDate = iso-    (\ (UniversalRep t) -> t ^/^ posixDayLength)+modJulianDate = iso ( \ (UniversalRep t) ->+        simply view seconds t / simply view seconds posixDayLength )     (UniversalRep . (*^ posixDayLength))  ------------------------------------------------------------------------
src/Data/Thyme/Clock/TAI.hs view
@@ -21,9 +21,8 @@ import Control.Lens import Control.Monad import Data.AffineSpace-import Data.Attoparsec.ByteString.Char8 (Parser, (<?>))+import Data.Attoparsec.ByteString.Char8 ((<?>)) import qualified Data.Attoparsec.ByteString.Char8 as P-import Data.Basis import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as S import Data.Char@@ -35,7 +34,6 @@ #else import qualified Data.Map as Map #endif-import Data.Micro import Data.Thyme.Calendar import Data.Thyme.Clock.Internal import Data.Thyme.Format.Internal@@ -102,7 +100,7 @@         show ymd ++ " is not Modified Julian Day " ++ show mjd      tokens ["TAI", "-", "UTC", "="]-    b <- micro <?> "Base"+    b <- P.rational <?> "Base"     tokens ["S", "+", "(", "MJD", "-"]     o <- P.rational <?> "Offset"     tokens [".", ")", "X"]@@ -111,19 +109,16 @@     -- FIXME: confirm UTC↔TAI conversion for pre-1972.     -- Do we round MJD? This is a guess:     -- TAI-UTC =  b + c * (MJD(UTC) - o)-    let atUTC (UTCRep (NominalDiffTime t)) = DiffTime $-            b ^+^ (c * (t ^/^ posixDay - o)) *^ basisValue ()-    let c1' = recip (1 + c); c1'c = c1' * c+    let atUTC (UTCRep t) = fromSeconds' $ b + c * (toMJD t - o)     -- TAI-UTC = (b + c * (MJD(TAI) - o)) / (1 + c)-    let atTAI (AbsoluteTime (DiffTime t)) = DiffTime $-            c1' *^ b ^+^ (c1'c * (t ^/^ posixDay - o)) *^ basisValue ()-    let begin = toRational mjd *^ posixDay+    let atTAI (AbsoluteTime t) = fromSeconds' $ b + c * (toMJD t - o) / (1 + c)+    let NominalDiffTime ((toRational mjd *^) -> begin) = posixDayLength     let beginUTC = UTCRep (NominalDiffTime begin)     let beginTAI = AbsoluteTime (DiffTime begin ^-^ atUTC beginUTC)     return ((beginUTC, atUTC), (beginTAI, atTAI))    where-    NominalDiffTime posixDay = posixDayLength+    toMJD t = simply view seconds t / simply view seconds posixDayLength     tokens = foldr (\ tok a -> P.skipSpace >> P.string tok >> a) P.skipSpace      parse row = pair . unzip . rights . map (P.parseOnly row) . S.lines@@ -134,13 +129,4 @@     look l = \ t -> case Map.splitLookup t (Map.fromList l) of         (lt, eq, _) -> maybe zeroV ($ t) $ eq <|> fst <$> Map.maxView lt #endif--    {-# INLINEABLE micro #-}-    micro :: Parser Micro-    micro = do-        sign <- negate <$ P.char '-' <|> pure id-        s <- P.decimal <* P.char '.'-        us10 <- either fail return . P.parseOnly P.decimal . S.take 7-            . (`S.append` S.pack "000000") =<< P.takeWhile1 P.isDigit-        return . Micro . sign $ s * 1000000 + div (us10 + 5) 10
src/Data/Thyme/Format.hs view
@@ -23,7 +23,6 @@ import Control.Monad.Trans.State.Strict import Data.Attoparsec.ByteString.Char8 (Parser) import qualified Data.Attoparsec.ByteString.Char8 as P-import Data.Basis import Data.Bits import qualified Data.ByteString.Char8 as S import Data.Char@@ -68,13 +67,13 @@         c : rest -> (:) c . go rest         [] -> id -{-# INLINE showsYear #-}-showsYear :: Year -> ShowS+{-# INLINE showsY #-}+showsY :: Year -> ShowS #if BUG_FOR_BUG-showsYear = shows+showsY = shows #else--- ISO 8601 says 4 digits, even for first millennium.-showsYear = shows04+-- ISO 8601 says minimum of 4 digits, even for first millennium.+showsY = showsYear #endif  instance FormatTime TimeOfDay where@@ -106,9 +105,9 @@     showsTime TimeLocale {..} (YearMonthDay y m d) = \ def c -> case c of         -- aggregate         'D' -> shows02 m . (:) '/' . shows02 d . (:) '/' . shows02 (mod y 100)-        'F' -> showsYear y . (:) '-' . shows02 m . (:) '-' . shows02 d+        'F' -> showsY y . (:) '-' . shows02 m . (:) '-' . shows02 d         -- Year-        'Y' -> showsYear y+        'Y' -> showsY y         'y' -> shows02 (mod y 100)         'C' -> shows02 (div y 100)         -- Month@@ -140,7 +139,7 @@     {-# INLINEABLE showsTime #-}     showsTime TimeLocale {..} (OrdinalDate y d) = \ def c -> case c of         -- Year-        'Y' -> showsYear y+        'Y' -> showsY y         'y' -> shows02 (mod y 100)         'C' -> shows02 (div y 100)         -- DayOfYear@@ -152,7 +151,7 @@     {-# INLINEABLE showsTime #-}     showsTime TimeLocale {..} (WeekDate y w d) = \ def c -> case c of         -- Year-        'G' -> showsYear y+        'G' -> showsY y         'g' -> shows02 (mod y 100)         'f' -> shows02 (div y 100)         -- WeekOfYear@@ -169,7 +168,7 @@     {-# INLINEABLE showsTime #-}     showsTime TimeLocale {..} (SundayWeek y w d) = \ def c -> case c of         -- Year-        'Y' -> showsYear y+        'Y' -> showsY y         'y' -> shows02 (mod y 100)         'C' -> shows02 (div y 100)         -- WeekOfYear@@ -186,7 +185,7 @@     {-# INLINEABLE showsTime #-}     showsTime TimeLocale {..} (MondayWeek y w d) = \ def c -> case c of         -- Year-        'Y' -> showsYear y+        'Y' -> showsY y         'y' -> shows02 (mod y 100)         'C' -> shows02 (div y 100)         -- WeekOfYear@@ -322,7 +321,7 @@              -- Year             -- FIXME: should full years / centuries be fixed width?-            'Y' -> lift (dec0 4) >>= setYear+            'Y' -> lift (negative P.decimal) >>= setYear             'y' -> lift (dec0 2) >>= setCenturyYear             'C' -> lift (dec0 2) >>= setCentury             -- Month@@ -359,7 +358,7 @@             -- UTCTime             's' -> do                 s <- lift (negative P.decimal)-                _tpPOSIXTime .= fromIntegral s *^ basisValue ()+                _tpPOSIXTime .= fromSeconds (s :: Int)                 flag IsPOSIXTime .= True                 go rspec @@ -494,7 +493,7 @@ instance ParseTime TimeOfDay where     {-# INLINE buildTime #-}     buildTime tp@TimeParse {..} = TimeOfDay h tpMinute-            (fromIntegral tpSecond *^ basisValue () ^+^ tpSecFrac) where+            (fromSeconds tpSecond ^+^ tpSecFrac) where         h = case tp ^. flag TwelveHour of             False -> tpHour             True -> case tp ^. flag PostMeridiem of
+ src/Data/Thyme/Format/Human.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ViewPatterns #-}++module Data.Thyme.Format.Human+    ( humanTimeDiff+    , humanTimeDiffs+    , humanRelTime+    , humanRelTimes+    ) where++import Prelude+import Control.Applicative+import Control.Lens hiding (singular)+import Control.Monad+import Data.AdditiveGroup+import Data.AffineSpace+import Data.Foldable+import Data.Micro+import Data.Monoid+import Data.Thyme.Clock.Internal+import Data.Thyme.TH+import Data.VectorSpace++data Unit = Unit+    { unit :: Micro+    , singular :: ShowS+    , plural :: ShowS+    }+thymeLenses ''Unit++-- | Display 'DiffTime' or 'NominalDiffTime' in a human-readable form.+{-# INLINE humanTimeDiff #-}+humanTimeDiff :: (TimeDiff d) => d -> String+humanTimeDiff d = humanTimeDiffs d ""++-- | Display 'DiffTime' or 'NominalDiffTime' in a human-readable form.+humanTimeDiffs :: (TimeDiff d) => d -> ShowS+humanTimeDiffs (microTimeDiff -> signed@(Micro (Micro . abs -> us)))+        = (if signed < Micro 0 then (:) '-' else id) . diff where+    diff = maybe id id . getFirst . fold $+        zipWith (approx us . unit) (tail units) units++-- | Display one 'UTCTime' relative to another, in a human-readable form.+{-# INLINE humanRelTime #-}+humanRelTime :: UTCTime -> UTCTime -> String+humanRelTime ref time = humanRelTimes ref time ""++-- | Display one 'UTCTime' relative to another, in a human-readable form.+humanRelTimes :: UTCTime -> UTCTime -> ShowS+humanRelTimes ref time = thence $ humanTimeDiffs diff where+    (diff, thence) = case compare delta zeroV of+        LT -> (negateV delta, ((++) "in " .))+        EQ -> (zeroV, const $ (++) "right now")+        GT -> (delta, (. (++) " ago"))+        where delta = time .-. ref++approx :: Micro -> Micro -> Unit -> First ShowS+approx us next Unit {..} = First $+        shows n . inflection <$ guard (us < next) where+    n = fst $ microQuotRem (us ^+^ half) unit where+        half = Micro . fst $ microQuotRem unit (Micro 2)+    inflection = if n == 1 then singular else plural++times :: String -> Rational -> Unit -> Unit+times ((++) . (:) ' ' -> singular) r Unit {unit}+    = Unit {unit = r *^ unit, plural = singular . (:) 's', ..}++units :: [Unit]+units = scanl (&) usec+    [ times "millisecond" 1000+    , times "second"      1000+    , times "minute"      60+    , times "hour"        60+    , times "day"         24+    , times "week"        7+    , times "month"       (30.4368 / 7)+    , times "year"        12+    , times "decade"      10+    , set _plural (" centuries" ++)+    . times "century"     10+    , set _plural (" millennia" ++)+    . times "millennium"  10+{-     , times "aeon"       1000000 -}+    , const (Unit maxBound id id)+    ] where+    usec = Unit (Micro 1) (" microsecond" ++) (" microseconds" ++)+
src/Data/Thyme/Format/Internal.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_HADDOCK hide #-}  module Data.Thyme.Format.Internal where @@ -37,11 +38,11 @@ ------------------------------------------------------------------------  {-# INLINE shows02 #-}-shows02 :: Int -> String -> String+shows02 :: Int -> ShowS shows02 n = if n < 10 then (:) '0' . shows n else shows n  {-# INLINE shows_2 #-}-shows_2 :: Int -> String -> String+shows_2 :: Int -> ShowS shows_2 n = if n < 10 then (:) ' ' . shows n else shows n  {-# INLINE shows03 #-}@@ -51,12 +52,12 @@     | n < 100 = (++) "0" . shows n     | otherwise = shows n -{-# INLINE shows04 #-}-shows04 :: Int -> String -> String-shows04 n@(abs -> u)-    | u < 10 = neg . (++) "000" . shows n-    | u < 100 = neg . (++) "00" . shows n-    | u < 1000 = neg . (++) "0" . shows n+{-# INLINE showsYear #-}+showsYear :: Int -> ShowS+showsYear n@(abs -> u)+    | u < 10 = neg . (++) "000" . shows u+    | u < 100 = neg . (++) "00" . shows u+    | u < 1000 = neg . (++) "0" . shows u     | otherwise = neg . shows u     where neg = if n < 0 then (:) '-' else id @@ -125,7 +126,7 @@  -- | Number may be prefixed with '-' {-# INLINE negative #-}-negative :: Parser Int64 -> Parser Int64+negative :: (Integral n) => Parser n -> Parser n negative p = ($) <$> (negate <$ P.char '-' <|> pure id) <*> p  -- | Fixed-length 0-padded decimal
src/Data/Thyme/LocalTime/Internal.hs view
@@ -3,8 +3,10 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_HADDOCK hide #-} --- #hide module Data.Thyme.LocalTime.Internal where  import Prelude hiding ((.))@@ -91,13 +93,14 @@ {-# INLINE dayFraction #-} dayFraction :: Iso' TimeOfDay Rational dayFraction = from timeOfDay . iso toRatio fromRatio where-    NominalDiffTime posixDay = posixDayLength +    {-# INLINEABLE toRatio #-}     toRatio :: DiffTime -> Rational-    toRatio (DiffTime t) = t ^/^ posixDay+    toRatio t = simply view seconds t / simply view seconds posixDayLength +    {-# INLINEABLE fromRatio #-}     fromRatio :: Rational -> DiffTime-    fromRatio r = DiffTime (r *^ posixDay)+    fromRatio ((*^ posixDayLength) -> NominalDiffTime r) = DiffTime r  ------------------------------------------------------------------------ -- * Local Time@@ -174,8 +177,12 @@  #if SHOW_INTERNAL deriving instance Show ZonedTime+instance Show UTCTime where+    showsPrec p = showsPrec p . view utcTime #else instance Show ZonedTime where     showsPrec p (ZonedTime lt tz) = showsPrec p lt . (:) ' ' . showsPrec p tz+instance Show UTCTime where+    showsPrec p = showsPrec p . view zonedTime . (,) utc #endif
src/Data/Thyme/LocalTime/TimeZone.hs view
@@ -6,20 +6,23 @@     , T.minutesToTimeZone     , T.hoursToTimeZone     , T.utc-    , T.getCurrentTimeZone     , module Data.Thyme.LocalTime.TimeZone     ) where  import Prelude import Control.Lens-import Data.Micro import Data.Thyme.Calendar-import Data.Thyme.Clock.Internal+import Data.Thyme.Clock import qualified Data.Time as T +{-# INLINEABLE getTimeZone #-} getTimeZone :: UTCTime -> IO T.TimeZone getTimeZone time = T.getTimeZone (T.UTCTime day dayTime) where     day = T.ModifiedJulianDay (fromIntegral mjd)-    dayTime = fromRational $ dt ^/^ DiffTime (toMicro 1)+    dayTime = fromRational (simply view seconds dt)     UTCTime (ModifiedJulianDay mjd) dt = view utcTime time++{-# INLINE getCurrentTimeZone #-}+getCurrentTimeZone :: IO T.TimeZone+getCurrentTimeZone = getCurrentTime >>= getTimeZone
src/Data/Thyme/TH.hs view
@@ -1,4 +1,5 @@--- #hide+{-# OPTIONS_HADDOCK hide #-}+ module Data.Thyme.TH (thymeLenses) where  import Prelude
src/Data/Thyme/Time.hs view
@@ -1,8 +1,5 @@-{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  -- | This module provides compatibility instances and wrappers for the@@ -23,32 +20,25 @@ -- --   * 'Year's are 'Int's, not 'Integer's: you may need 'fromIntegral'. ----- You shouldn't need to use @lens@ or @vector-space@ if you don't want to.+-- You shouldn't need to use @lens@ or @vector-space@ directly if you don't+-- want to. However if you do use @vector-space@ and wish to avoid the+-- 'RealFrac' instances for 'DiffTime' and 'NominalDiffTime', import+-- "Data.Thyme.Time.Core" instead. -- -- Anything else is probably not intentional, and you should either contact -- me via IRC or file an issue at <https://github.com/liyang/thyme/issues>.  module Data.Thyme.Time-    ( module Data.Thyme-    , module Data.Thyme.Time+    ( module Data.Thyme.Time.Core+    {- instance RealFrac {,Nominal}DiffTime -}     ) where -import Control.Lens-import Data.AffineSpace-import Data.Int+import Prelude import Data.Micro import Data.Ratio import Data.Thyme-import Data.Thyme.Calendar.OrdinalDate-import Data.Thyme.Calendar.MonthDay-import Data.Thyme.Calendar.WeekDate import Data.Thyme.Clock.Internal-import Data.Thyme.Clock.POSIX-import Data.Thyme.Clock.TAI-import qualified Data.Time.Calendar as T-import qualified Data.Time.Clock as T-import qualified Data.Time.Clock.TAI as T-import qualified Data.Time.LocalTime as T+import Data.Thyme.Time.Core  instance Num Micro where     {-# INLINE (+) #-}@@ -74,7 +64,7 @@     {-# INLINE (/) #-}     {-# INLINE recip #-}     {-# INLINE fromRational #-}-    Micro a / Micro b = Micro (quot (a * 1000) (b * 1000))+    Micro a / Micro b = Micro (quot (a * 1000) (b `quot` 1000))     recip (Micro a) = Micro (quot 1000000 a)     fromRational = toMicro @@ -93,305 +83,20 @@ deriving instance Fractional NominalDiffTime deriving instance RealFrac NominalDiffTime ---------------------------------------------------------------------------- * Type conversion--class Thyme a b | b -> a where-    thyme :: Iso' a b--instance Thyme T.Day Day where-    {-# INLINE thyme #-}-    thyme = iso-        (ModifiedJulianDay . fromInteger . T.toModifiedJulianDay)-        (T.ModifiedJulianDay . fromIntegral . toModifiedJulianDay)--instance Thyme T.UniversalTime UniversalTime where-    {-# INLINE thyme #-}-    thyme = iso T.getModJulianDate T.ModJulianDate . from modJulianDate--instance Thyme T.DiffTime DiffTime where-    {-# INLINE thyme #-}-    thyme = iso (round . (*) 1000000)-        (T.picosecondsToDiffTime . (*) 1000000 . toInteger) . microDiffTime--instance Thyme T.UTCTime UTCView where-    {-# INLINE thyme #-}-    thyme = iso-        (\ (T.UTCTime d t) -> UTCTime (view thyme d) (view thyme t))-        (\ (UTCTime d t) -> T.UTCTime (review thyme d) (review thyme t))--instance Thyme T.UTCTime UTCTime where-    {-# INLINE thyme #-}-    thyme = thyme . from utcTime--instance Thyme T.NominalDiffTime NominalDiffTime where-    {-# INLINE thyme #-}-    thyme = iso (round . (*) 1000000) -- no picosecondsToNominalDiffTime D:-        (fromRational . (% 1000000) . toInteger) . microNominalDiffTime--instance Thyme T.AbsoluteTime AbsoluteTime where-    {-# INLINE thyme #-}-    thyme = iso (`T.diffAbsoluteTime` T.taiEpoch)-            (`T.addAbsoluteTime` T.taiEpoch)-        . thyme . iso (taiEpoch .+^) (.-. taiEpoch)--instance Thyme T.TimeZone TimeZone where-    {-# INLINE thyme #-}-    thyme = id--instance Thyme T.TimeOfDay TimeOfDay where-    {-# INLINE thyme #-}-    thyme = iso ( \ (T.TimeOfDay h m s) -> TimeOfDay h m-            . view microDiffTime . round $ s * 1000000 )-        ( \ (TimeOfDay h m s) -> T.TimeOfDay h m . fromRational-            . (% 1000000) . toInteger $ review microDiffTime s )--instance Thyme T.LocalTime LocalTime where-    {-# INLINE thyme #-}-    thyme = iso-        (\ (T.LocalTime d t) -> LocalTime (view thyme d) (view thyme t))-        (\ (LocalTime d t) -> T.LocalTime (review thyme d) (review thyme t))--instance Thyme T.ZonedTime ZonedTime where-    {-# INLINE thyme #-}-    thyme = iso-        (\ (T.ZonedTime t z) -> ZonedTime (view thyme t) (view thyme z))-        (\ (ZonedTime t z) -> T.ZonedTime (review thyme t) (review thyme z))--{-# INLINE toThyme #-}-toThyme :: (Thyme a b) => a -> b-toThyme = view thyme--{-# INLINE fromThyme #-}-fromThyme :: (Thyme a b) => b -> a-fromThyme = review thyme----------------------------------------------------------------------------- * @Data.Time.Calendar@--{-# INLINE addDays #-}-addDays :: Days -> Day -> Day-addDays = flip (.+^)--{-# INLINE diffDays #-}-diffDays :: Day -> Day -> Days-diffDays = (.-.)--{-# INLINE toGregorian #-}-toGregorian :: Day -> (Year, Month, DayOfMonth)-toGregorian (view gregorian -> YearMonthDay y m d) = (y, m, d)--{-# INLINE fromGregorian #-}-fromGregorian :: Year -> Month -> DayOfMonth -> Day-fromGregorian y m d = review gregorian (YearMonthDay y m d)--{-# INLINE fromGregorianValid #-}-fromGregorianValid :: Year -> Month -> DayOfMonth -> Maybe Day-fromGregorianValid y m d = gregorianValid (YearMonthDay y m d)--{-# INLINE addGregorianMonthsClip #-}-addGregorianMonthsClip :: Months -> Day -> Day-addGregorianMonthsClip n = review gregorian-    . gregorianMonthsClip n . view gregorian--{-# INLINE addGregorianMonthsRollover #-}-addGregorianMonthsRollover :: Months -> Day -> Day-addGregorianMonthsRollover n = review gregorian-    . gregorianMonthsRollover n . view gregorian--{-# INLINE addGregorianYearsClip #-}-addGregorianYearsClip :: Years -> Day -> Day-addGregorianYearsClip n = review gregorian-    . gregorianYearsClip n . view gregorian--{-# INLINE addGregorianYearsRollover #-}-addGregorianYearsRollover :: Years -> Day -> Day-addGregorianYearsRollover n = review gregorian-    . gregorianYearsRollover n . view gregorian----------------------------------------------------------------------------- * @Data.Time.Calendar.MonthDay@--{-# INLINE dayOfYearToMonthAndDay #-}-dayOfYearToMonthAndDay :: Bool -> DayOfYear -> (Month, DayOfMonth)-dayOfYearToMonthAndDay leap (view (monthDay leap) -> MonthDay m d) = (m, d)--{-# INLINE monthAndDayToDayOfYear #-}-monthAndDayToDayOfYear :: Bool -> Month -> DayOfMonth -> DayOfYear-monthAndDayToDayOfYear leap m d = review (monthDay leap) (MonthDay m d)--{-# INLINE monthAndDayToDayOfYearValid #-}-monthAndDayToDayOfYearValid :: Bool -> Month -> DayOfMonth -> Maybe DayOfYear-monthAndDayToDayOfYearValid leap m d = monthDayValid leap (MonthDay m d)----------------------------------------------------------------------------- * @Data.Time.Calendar.OrdinalDate@--{-# INLINE toOrdinalDate #-}-toOrdinalDate :: Day -> (Year, DayOfYear)-toOrdinalDate (view ordinalDate -> OrdinalDate y d) = (y, d)--{-# INLINE fromOrdinalDate #-}-fromOrdinalDate :: Year -> DayOfYear -> Day-fromOrdinalDate y d = review ordinalDate (OrdinalDate y d)--{-# INLINE fromOrdinalDateValid #-}-fromOrdinalDateValid :: Year -> DayOfYear -> Maybe Day-fromOrdinalDateValid y d = ordinalDateValid (OrdinalDate y d)--{-# INLINE sundayStartWeek #-}-sundayStartWeek :: Day -> (Year, WeekOfYear, DayOfWeek)-sundayStartWeek (view sundayWeek -> SundayWeek y w d) = (y, w, d)--{-# INLINE fromSundayStartWeek #-}-fromSundayStartWeek :: Year -> WeekOfYear -> DayOfWeek -> Day-fromSundayStartWeek y w d = review sundayWeek (SundayWeek y w d)--{-# INLINE fromSundayStartWeekValid #-}-fromSundayStartWeekValid :: Year -> WeekOfYear -> DayOfWeek -> Maybe Day-fromSundayStartWeekValid y w d = sundayWeekValid (SundayWeek y w d)--{-# INLINE mondayStartWeek #-}-mondayStartWeek :: Day -> (Year, WeekOfYear, DayOfWeek)-mondayStartWeek (view mondayWeek -> MondayWeek y w d) = (y, w, d)--{-# INLINE fromMondayStartWeek #-}-fromMondayStartWeek :: Year -> WeekOfYear -> DayOfWeek -> Day-fromMondayStartWeek y w d = review mondayWeek (MondayWeek y w d)--{-# INLINE fromMondayStartWeekValid #-}-fromMondayStartWeekValid :: Year -> WeekOfYear -> DayOfWeek -> Maybe Day-fromMondayStartWeekValid y w d = mondayWeekValid (MondayWeek y w d)----------------------------------------------------------------------------- * @Data.Time.Calendar.WeekDate@--{-# INLINE toWeekDate #-}-toWeekDate :: Day -> (Year, WeekOfYear, DayOfWeek)-toWeekDate (view weekDate -> WeekDate y w d) = (y, w, d)--{-# INLINE fromWeekDate #-}-fromWeekDate :: Year -> WeekOfYear -> DayOfWeek -> Day-fromWeekDate y w d = review weekDate (WeekDate y w d)--{-# INLINE fromWeekDateValid #-}-fromWeekDateValid :: Year -> WeekOfYear -> DayOfWeek -> Maybe Day-fromWeekDateValid y w d = weekDateValid (WeekDate y w d)----------------------------------------------------------------------------- * @Data.Time.Clock@--{-# INLINE getModJulianDate #-}-getModJulianDate :: UniversalTime -> Rational-getModJulianDate = view modJulianDate---- | Replacement for 'T.ModJulianDate'.-{-# INLINE mkModJulianDate #-}-mkModJulianDate :: Rational -> UniversalTime-mkModJulianDate = review modJulianDate--{-# INLINE secondsToDiffTime #-}-secondsToDiffTime :: Int64 -> DiffTime-secondsToDiffTime a = DiffTime (Micro $ a * 1000000)--{-# INLINE picosecondsToDiffTime #-}-picosecondsToDiffTime :: Int64 -> DiffTime-picosecondsToDiffTime a = DiffTime (Micro $ div (a + 500000) 1000000)--{-# INLINE mkUTCTime #-}-mkUTCTime :: Day -> DiffTime -> UTCTime-mkUTCTime d t = review utcTime (UTCTime d t)--{-# INLINE unUTCTime #-}-unUTCTime :: UTCTime -> UTCView-unUTCTime = view utcTime--{-# INLINE addUTCTime #-}-addUTCTime :: NominalDiffTime -> UTCTime -> UTCTime-addUTCTime = flip (.+^)--{-# INLINE diffUTCTime #-}-diffUTCTime :: UTCTime -> UTCTime -> NominalDiffTime-diffUTCTime = (.-.)----------------------------------------------------------------------------- * @Data.Time.Clock.POSIX@--{-# INLINE posixSecondsToUTCTime #-}-posixSecondsToUTCTime :: POSIXTime -> UTCTime-posixSecondsToUTCTime = review posixTime--{-# INLINE utcTimeToPOSIXSeconds #-}-utcTimeToPOSIXSeconds :: UTCTime -> POSIXTime-utcTimeToPOSIXSeconds = view posixTime----------------------------------------------------------------------------- * @Data.Time.Clock.TAI@--{-# INLINE addAbsoluteTime #-}-addAbsoluteTime :: DiffTime -> AbsoluteTime -> AbsoluteTime-addAbsoluteTime = flip (.+^)--{-# INLINE diffAbsoluteTime #-}-diffAbsoluteTime :: AbsoluteTime -> AbsoluteTime -> DiffTime-diffAbsoluteTime = (.-.)--{-# INLINE utcToTAITime #-}-utcToTAITime :: LeapSecondTable -> UTCTime -> AbsoluteTime-utcToTAITime = view . absoluteTime--{-# INLINE taiToUTCTime #-}-taiToUTCTime :: LeapSecondTable -> AbsoluteTime -> UTCTime-taiToUTCTime = review . absoluteTime----------------------------------------------------------------------------- * @Data.Time.LocalTime@--{-# INLINE utcToLocalTimeOfDay #-}-utcToLocalTimeOfDay :: TimeZone -> TimeOfDay -> (Days, TimeOfDay)-utcToLocalTimeOfDay = addMinutes . timeZoneMinutes--{-# INLINE localToUTCTimeOfDay #-}-localToUTCTimeOfDay :: TimeZone -> TimeOfDay -> (Days, TimeOfDay)-localToUTCTimeOfDay = addMinutes . negate . timeZoneMinutes--{-# INLINE timeToTimeOfDay #-}-timeToTimeOfDay :: DiffTime -> TimeOfDay-timeToTimeOfDay = view timeOfDay--{-# INLINE timeOfDayToTime #-}-timeOfDayToTime :: TimeOfDay -> DiffTime-timeOfDayToTime = review timeOfDay--{-# INLINE dayFractionToTimeOfDay #-}-dayFractionToTimeOfDay :: Rational -> TimeOfDay-dayFractionToTimeOfDay = review dayFraction--{-# INLINE timeOfDayToDayFraction #-}-timeOfDayToDayFraction :: TimeOfDay -> Rational-timeOfDayToDayFraction = view dayFraction--{-# INLINE utcToLocalTime #-}-utcToLocalTime :: TimeZone -> UTCTime -> LocalTime-utcToLocalTime = view . utcLocalTime--{-# INLINE localTimeToUTC #-}-localTimeToUTC :: TimeZone -> LocalTime -> UTCTime-localTimeToUTC = review . utcLocalTime--{-# INLINE ut1ToLocalTime #-}-ut1ToLocalTime :: Rational -> UniversalTime -> LocalTime-ut1ToLocalTime = view . ut1LocalTime+{-# RULES -{-# INLINE localTimeToUT1 #-}-localTimeToUT1 :: Rational -> LocalTime -> UniversalTime-localTimeToUT1 = review . ut1LocalTime+"realToFrac∷DiffTime→NominalDiffTime"+    realToFrac = \ (DiffTime d) -> NominalDiffTime d+"realToFrac∷NominalDiffTime→DiffTime"+    realToFrac = \ (NominalDiffTime d) -> DiffTime d -{-# INLINE utcToZonedTime #-}-utcToZonedTime :: TimeZone -> UTCTime -> ZonedTime-utcToZonedTime z t = view zonedTime (z, t)+"realToFrac∷DiffTime→Fractional"+    realToFrac = toSeconds :: (Fractional n) => DiffTime -> n+"realToFrac∷NominalDiffTime→Fractional"+    realToFrac = toSeconds :: (Fractional n) => NominalDiffTime -> n -{-# INLINE zonedTimeToUTC #-}-zonedTimeToUTC :: ZonedTime -> UTCTime-zonedTimeToUTC = snd . review zonedTime+"realToFrac∷Real→DiffTime"+    realToFrac = fromSeconds :: (Real n) => n -> DiffTime+"realToFrac∷Real→NominalDiffTime"+    realToFrac = fromSeconds :: (Real n) => n -> NominalDiffTime #-}
+ src/Data/Thyme/Time/Core.hs view
@@ -0,0 +1,333 @@+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ViewPatterns #-}++-- | This module provides just the compatibility wrappers for the things+-- that @thyme@ does differently from @time@. No 'RealFrac' instances for+-- 'DiffTime' nor 'NominalDiffTime', nor other riffraff.++module Data.Thyme.Time.Core+    ( module Data.Thyme+    , module Data.Thyme.Time.Core+    ) where++import Prelude+import Control.Lens+import Data.AffineSpace+import Data.Int+import Data.Micro+import Data.Ratio+import Data.Thyme+import Data.Thyme.Calendar.OrdinalDate+import Data.Thyme.Calendar.MonthDay+import Data.Thyme.Calendar.WeekDate+import Data.Thyme.Clock.Internal+import Data.Thyme.Clock.POSIX+import Data.Thyme.Clock.TAI+import qualified Data.Time.Calendar as T+import qualified Data.Time.Clock as T+import qualified Data.Time.Clock.TAI as T+import qualified Data.Time.LocalTime as T++------------------------------------------------------------------------+-- * Type conversion++class Thyme a b | b -> a where+    thyme :: Iso' a b++instance Thyme T.Day Day where+    {-# INLINE thyme #-}+    thyme = iso+        (ModifiedJulianDay . fromInteger . T.toModifiedJulianDay)+        (T.ModifiedJulianDay . fromIntegral . toModifiedJulianDay)++instance Thyme T.UniversalTime UniversalTime where+    {-# INLINE thyme #-}+    thyme = iso T.getModJulianDate T.ModJulianDate . from modJulianDate++instance Thyme T.DiffTime DiffTime where+    {-# INLINE thyme #-}+    thyme = iso (round . (*) 1000000)+        (T.picosecondsToDiffTime . (*) 1000000 . toInteger) . microDiffTime++instance Thyme T.UTCTime UTCView where+    {-# INLINE thyme #-}+    thyme = iso+        (\ (T.UTCTime d t) -> UTCTime (view thyme d) (view thyme t))+        (\ (UTCTime d t) -> T.UTCTime (review thyme d) (review thyme t))++instance Thyme T.UTCTime UTCTime where+    {-# INLINE thyme #-}+    thyme = thyme . from utcTime++instance Thyme T.NominalDiffTime NominalDiffTime where+    {-# INLINE thyme #-}+    thyme = iso (round . (*) 1000000) -- no picosecondsToNominalDiffTime D:+        (fromRational . (% 1000000) . toInteger) . microNominalDiffTime++instance Thyme T.AbsoluteTime AbsoluteTime where+    {-# INLINE thyme #-}+    thyme = iso (`T.diffAbsoluteTime` T.taiEpoch)+            (`T.addAbsoluteTime` T.taiEpoch)+        . thyme . iso (taiEpoch .+^) (.-. taiEpoch)++instance Thyme T.TimeZone TimeZone where+    {-# INLINE thyme #-}+    thyme = id++instance Thyme T.TimeOfDay TimeOfDay where+    {-# INLINE thyme #-}+    thyme = iso ( \ (T.TimeOfDay h m s) -> TimeOfDay h m+            . view microDiffTime . round $ s * 1000000 )+        ( \ (TimeOfDay h m s) -> T.TimeOfDay h m . fromRational+            . (% 1000000) . toInteger $ review microDiffTime s )++instance Thyme T.LocalTime LocalTime where+    {-# INLINE thyme #-}+    thyme = iso+        (\ (T.LocalTime d t) -> LocalTime (view thyme d) (view thyme t))+        (\ (LocalTime d t) -> T.LocalTime (review thyme d) (review thyme t))++instance Thyme T.ZonedTime ZonedTime where+    {-# INLINE thyme #-}+    thyme = iso+        (\ (T.ZonedTime t z) -> ZonedTime (view thyme t) (view thyme z))+        (\ (ZonedTime t z) -> T.ZonedTime (review thyme t) (review thyme z))++{-# INLINE toThyme #-}+toThyme :: (Thyme a b) => a -> b+toThyme = view thyme++{-# INLINE fromThyme #-}+fromThyme :: (Thyme a b) => b -> a+fromThyme = review thyme++------------------------------------------------------------------------+-- * @Data.Time.Calendar@++{-# INLINE addDays #-}+addDays :: Days -> Day -> Day+addDays = flip (.+^)++{-# INLINE diffDays #-}+diffDays :: Day -> Day -> Days+diffDays = (.-.)++{-# INLINE toGregorian #-}+toGregorian :: Day -> (Year, Month, DayOfMonth)+toGregorian (view gregorian -> YearMonthDay y m d) = (y, m, d)++{-# INLINE fromGregorian #-}+fromGregorian :: Year -> Month -> DayOfMonth -> Day+fromGregorian y m d = review gregorian (YearMonthDay y m d)++{-# INLINE fromGregorianValid #-}+fromGregorianValid :: Year -> Month -> DayOfMonth -> Maybe Day+fromGregorianValid y m d = gregorianValid (YearMonthDay y m d)++{-# INLINE addGregorianMonthsClip #-}+addGregorianMonthsClip :: Months -> Day -> Day+addGregorianMonthsClip n = review gregorian+    . gregorianMonthsClip n . view gregorian++{-# INLINE addGregorianMonthsRollover #-}+addGregorianMonthsRollover :: Months -> Day -> Day+addGregorianMonthsRollover n = review gregorian+    . gregorianMonthsRollover n . view gregorian++{-# INLINE addGregorianYearsClip #-}+addGregorianYearsClip :: Years -> Day -> Day+addGregorianYearsClip n = review gregorian+    . gregorianYearsClip n . view gregorian++{-# INLINE addGregorianYearsRollover #-}+addGregorianYearsRollover :: Years -> Day -> Day+addGregorianYearsRollover n = review gregorian+    . gregorianYearsRollover n . view gregorian++------------------------------------------------------------------------+-- * @Data.Time.Calendar.MonthDay@++{-# INLINE dayOfYearToMonthAndDay #-}+dayOfYearToMonthAndDay :: Bool -> DayOfYear -> (Month, DayOfMonth)+dayOfYearToMonthAndDay leap (view (monthDay leap) -> MonthDay m d) = (m, d)++{-# INLINE monthAndDayToDayOfYear #-}+monthAndDayToDayOfYear :: Bool -> Month -> DayOfMonth -> DayOfYear+monthAndDayToDayOfYear leap m d = review (monthDay leap) (MonthDay m d)++{-# INLINE monthAndDayToDayOfYearValid #-}+monthAndDayToDayOfYearValid :: Bool -> Month -> DayOfMonth -> Maybe DayOfYear+monthAndDayToDayOfYearValid leap m d = monthDayValid leap (MonthDay m d)++------------------------------------------------------------------------+-- * @Data.Time.Calendar.OrdinalDate@++{-# INLINE toOrdinalDate #-}+toOrdinalDate :: Day -> (Year, DayOfYear)+toOrdinalDate (view ordinalDate -> OrdinalDate y d) = (y, d)++{-# INLINE fromOrdinalDate #-}+fromOrdinalDate :: Year -> DayOfYear -> Day+fromOrdinalDate y d = review ordinalDate (OrdinalDate y d)++{-# INLINE fromOrdinalDateValid #-}+fromOrdinalDateValid :: Year -> DayOfYear -> Maybe Day+fromOrdinalDateValid y d = ordinalDateValid (OrdinalDate y d)++{-# INLINE sundayStartWeek #-}+sundayStartWeek :: Day -> (Year, WeekOfYear, DayOfWeek)+sundayStartWeek (view sundayWeek -> SundayWeek y w d) = (y, w, d)++{-# INLINE fromSundayStartWeek #-}+fromSundayStartWeek :: Year -> WeekOfYear -> DayOfWeek -> Day+fromSundayStartWeek y w d = review sundayWeek (SundayWeek y w d)++{-# INLINE fromSundayStartWeekValid #-}+fromSundayStartWeekValid :: Year -> WeekOfYear -> DayOfWeek -> Maybe Day+fromSundayStartWeekValid y w d = sundayWeekValid (SundayWeek y w d)++{-# INLINE mondayStartWeek #-}+mondayStartWeek :: Day -> (Year, WeekOfYear, DayOfWeek)+mondayStartWeek (view mondayWeek -> MondayWeek y w d) = (y, w, d)++{-# INLINE fromMondayStartWeek #-}+fromMondayStartWeek :: Year -> WeekOfYear -> DayOfWeek -> Day+fromMondayStartWeek y w d = review mondayWeek (MondayWeek y w d)++{-# INLINE fromMondayStartWeekValid #-}+fromMondayStartWeekValid :: Year -> WeekOfYear -> DayOfWeek -> Maybe Day+fromMondayStartWeekValid y w d = mondayWeekValid (MondayWeek y w d)++------------------------------------------------------------------------+-- * @Data.Time.Calendar.WeekDate@++{-# INLINE toWeekDate #-}+toWeekDate :: Day -> (Year, WeekOfYear, DayOfWeek)+toWeekDate (view weekDate -> WeekDate y w d) = (y, w, d)++{-# INLINE fromWeekDate #-}+fromWeekDate :: Year -> WeekOfYear -> DayOfWeek -> Day+fromWeekDate y w d = review weekDate (WeekDate y w d)++{-# INLINE fromWeekDateValid #-}+fromWeekDateValid :: Year -> WeekOfYear -> DayOfWeek -> Maybe Day+fromWeekDateValid y w d = weekDateValid (WeekDate y w d)++------------------------------------------------------------------------+-- * @Data.Time.Clock@++{-# INLINE getModJulianDate #-}+getModJulianDate :: UniversalTime -> Rational+getModJulianDate = view modJulianDate++-- | Replacement for 'T.ModJulianDate'.+{-# INLINE mkModJulianDate #-}+mkModJulianDate :: Rational -> UniversalTime+mkModJulianDate = review modJulianDate++{-# INLINE secondsToDiffTime #-}+secondsToDiffTime :: Int64 -> DiffTime+secondsToDiffTime a = DiffTime (Micro $ a * 1000000)++{-# INLINE picosecondsToDiffTime #-}+picosecondsToDiffTime :: Int64 -> DiffTime+picosecondsToDiffTime a = DiffTime (Micro $ div (a + 500000) 1000000)++{-# INLINE mkUTCTime #-}+mkUTCTime :: Day -> DiffTime -> UTCTime+mkUTCTime d t = review utcTime (UTCTime d t)++{-# INLINE unUTCTime #-}+unUTCTime :: UTCTime -> UTCView+unUTCTime = view utcTime++{-# INLINE addUTCTime #-}+addUTCTime :: NominalDiffTime -> UTCTime -> UTCTime+addUTCTime = flip (.+^)++{-# INLINE diffUTCTime #-}+diffUTCTime :: UTCTime -> UTCTime -> NominalDiffTime+diffUTCTime = (.-.)++------------------------------------------------------------------------+-- * @Data.Time.Clock.POSIX@++{-# INLINE posixSecondsToUTCTime #-}+posixSecondsToUTCTime :: POSIXTime -> UTCTime+posixSecondsToUTCTime = review posixTime++{-# INLINE utcTimeToPOSIXSeconds #-}+utcTimeToPOSIXSeconds :: UTCTime -> POSIXTime+utcTimeToPOSIXSeconds = view posixTime++------------------------------------------------------------------------+-- * @Data.Time.Clock.TAI@++{-# INLINE addAbsoluteTime #-}+addAbsoluteTime :: DiffTime -> AbsoluteTime -> AbsoluteTime+addAbsoluteTime = flip (.+^)++{-# INLINE diffAbsoluteTime #-}+diffAbsoluteTime :: AbsoluteTime -> AbsoluteTime -> DiffTime+diffAbsoluteTime = (.-.)++{-# INLINE utcToTAITime #-}+utcToTAITime :: LeapSecondTable -> UTCTime -> AbsoluteTime+utcToTAITime = view . absoluteTime++{-# INLINE taiToUTCTime #-}+taiToUTCTime :: LeapSecondTable -> AbsoluteTime -> UTCTime+taiToUTCTime = review . absoluteTime++------------------------------------------------------------------------+-- * @Data.Time.LocalTime@++{-# INLINE utcToLocalTimeOfDay #-}+utcToLocalTimeOfDay :: TimeZone -> TimeOfDay -> (Days, TimeOfDay)+utcToLocalTimeOfDay = addMinutes . timeZoneMinutes++{-# INLINE localToUTCTimeOfDay #-}+localToUTCTimeOfDay :: TimeZone -> TimeOfDay -> (Days, TimeOfDay)+localToUTCTimeOfDay = addMinutes . negate . timeZoneMinutes++{-# INLINE timeToTimeOfDay #-}+timeToTimeOfDay :: DiffTime -> TimeOfDay+timeToTimeOfDay = view timeOfDay++{-# INLINE timeOfDayToTime #-}+timeOfDayToTime :: TimeOfDay -> DiffTime+timeOfDayToTime = review timeOfDay++{-# INLINE dayFractionToTimeOfDay #-}+dayFractionToTimeOfDay :: Rational -> TimeOfDay+dayFractionToTimeOfDay = review dayFraction++{-# INLINE timeOfDayToDayFraction #-}+timeOfDayToDayFraction :: TimeOfDay -> Rational+timeOfDayToDayFraction = view dayFraction++{-# INLINE utcToLocalTime #-}+utcToLocalTime :: TimeZone -> UTCTime -> LocalTime+utcToLocalTime = view . utcLocalTime++{-# INLINE localTimeToUTC #-}+localTimeToUTC :: TimeZone -> LocalTime -> UTCTime+localTimeToUTC = review . utcLocalTime++{-# INLINE ut1ToLocalTime #-}+ut1ToLocalTime :: Rational -> UniversalTime -> LocalTime+ut1ToLocalTime = view . ut1LocalTime++{-# INLINE localTimeToUT1 #-}+localTimeToUT1 :: Rational -> LocalTime -> UniversalTime+localTimeToUT1 = review . ut1LocalTime++{-# INLINE utcToZonedTime #-}+utcToZonedTime :: TimeZone -> UTCTime -> ZonedTime+utcToZonedTime z t = view zonedTime (z, t)++{-# INLINE zonedTimeToUTC #-}+zonedTimeToUTC :: ZonedTime -> UTCTime+zonedTimeToUTC = snd . review zonedTime+
tests/Common.hs view
@@ -4,9 +4,7 @@ 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@@ -17,15 +15,21 @@ ------------------------------------------------------------------------  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)+    arbitrary = ModifiedJulianDay <$> arbitrary  instance Arbitrary DiffTime where-    arbitrary = (^*) (basisValue ()) . toRational <$> (choose (0, 86400.999999) :: Gen Double)+    arbitrary = view microDiffTime <$> arbitrary +instance Arbitrary NominalDiffTime where+    arbitrary = view microNominalDiffTime <$> arbitrary+ instance Arbitrary UTCTime where-    arbitrary = fmap (review utcTime) $ UTCTime <$> arbitrary <*> arbitrary+    arbitrary = fmap (review utcTime) $ UTCTime+            <$> (ModifiedJulianDay <$> choose (mjd0, mjd1))+            <*> (view microDiffTime <$> choose (0, 86400999999)) where+        -- FIXME: We disagree with time on how many digits to use for year.+        ModifiedJulianDay mjd0 = review gregorian $ YearMonthDay 1000 1 1+        ModifiedJulianDay mjd1 = review gregorian $ YearMonthDay 9999 12 31  ------------------------------------------------------------------------
tests/bench.hs view
@@ -9,7 +9,6 @@ import Criterion.Config import Criterion.Environment import Criterion.Monad-import Data.Basis import Data.Monoid import Data.Thyme import Data.Thyme.Calendar.OrdinalDate@@ -20,7 +19,6 @@ 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@@ -37,7 +35,7 @@     now <- getCurrentTime     let now' = review thyme now     let strs = T.formatTime defaultTimeLocale spec <$> utcs'-    let dt = 86405 *^ basisValue ()+    let dt = fromSeconds' 86405     let dt' = review thyme dt     let days = utctDay . unUTCTime <$> utcs     let days' = T.utctDay <$> utcs'
tests/sanity.hs view
@@ -53,12 +53,19 @@     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)+ ------------------------------------------------------------------------  main :: IO ()-main = (exit . all isSuccess <=< mapM quickCheckResult) $-        prop_formatTime :-        prop_parseTime :+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     isSuccess r = case r of Success {} -> True; _ -> False
thyme.cabal view
@@ -1,5 +1,5 @@ name:           thyme-version:        0.2.3.0+version:        0.2.4.1 synopsis:       A faster time library description:     Thyme is a rewrite of the fine @time@ library, with a particular focus@@ -49,8 +49,10 @@         Data.Thyme.Clock.POSIX         Data.Thyme.Clock.TAI         Data.Thyme.Format+        Data.Thyme.Format.Human         Data.Thyme.LocalTime         Data.Thyme.Time+        Data.Thyme.Time.Core     other-modules:         Data.Micro         Data.Thyme.Calendar.Internal