packages feed

thyme 0.3.1.1 → 0.3.2.0

raw patch · 27 files changed

+733/−379 lines, 27 filesdep +Win32dep +mtldep +profunctorsdep −template-haskelldep −transformersdep ~hlint

Dependencies added: Win32, mtl, profunctors

Dependencies removed: template-haskell, transformers

Dependency ranges changed: hlint

Files

include/thyme.h view
@@ -1,3 +1,5 @@ #define INSTANCES_USUAL     Eq, Ord, Data, Typeable, Generic #define INSTANCES_NEWTYPE   INSTANCES_USUAL, Enum, Ix, NFData-#define INSTANCES_MICRO     INSTANCES_NEWTYPE, Bounded, Random, Arbitrary+#define INSTANCES_MICRO     INSTANCES_NEWTYPE, Bounded, Random, Arbitrary, CoArbitrary+#define LensP Lens'+#define LENS(S,F,A) {-# INLINE _/**/F #-}; _/**/F :: LensP S A; _/**/F = lens F $ \ S {..} F/**/_ -> S {F = F/**/_, ..}
+ lens/Control/Lens.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE RankNTypes #-}++-- | Small replacement for <http://hackage.haskell.org/package/lens lens>.+module Control.Lens+    ( (&)+    , Iso, Iso', iso+    , from+    , review, ( # )+    , Lens, Lens', lens+    , view, (^.)+    , set, assign, (.=)+    ) where++import Control.Applicative+import Control.Monad.Identity+import Control.Monad.State.Class as State+import Data.Profunctor+import Data.Profunctor.Unsafe+import Unsafe.Coerce++(&) :: a -> (a -> b) -> b+a & f = f a+{-# INLINE (&) #-}++type Overloaded p f s t a b = p a (f b) -> p s (f t)++------------------------------------------------------------------------++type Iso s t a b = forall p f. (Profunctor p, Functor f) => Overloaded p f s t a b+type Iso' s a = Iso s s a a++iso :: (s -> a) -> (b -> t) -> Iso s t a b+iso sa bt = dimap sa (fmap bt)+{-# INLINE iso #-}++------------------------------------------------------------------------++data Exchange a b s t = Exchange (s -> a) (b -> t)++instance Profunctor (Exchange a b) where+  dimap f g (Exchange sa bt) = Exchange (sa . f) (g . bt)+  {-# INLINE dimap #-}+  lmap f (Exchange sa bt) = Exchange (sa . f) bt+  {-# INLINE lmap #-}+  rmap f (Exchange sa bt) = Exchange sa (f . bt)+  {-# INLINE rmap #-}+  ( #. ) _ = unsafeCoerce+  {-# INLINE ( #. ) #-}+  ( .# ) p _ = unsafeCoerce p+  {-# INLINE ( .# ) #-}++type AnIso s t a b = Overloaded (Exchange a b) Identity s t a b++from :: AnIso s t a b -> Iso b a t s+from l = case l (Exchange id Identity) of+  Exchange sa bt -> iso (runIdentity #. bt) sa+{-# INLINE from #-}++------------------------------------------------------------------------++newtype Reviewed a b = Reviewed+    { runReviewed :: b+    } deriving (Functor)++instance Profunctor Reviewed where+  dimap _ f (Reviewed c) = Reviewed (f c)+  {-# INLINE dimap #-}+  lmap _ (Reviewed c) = Reviewed c+  {-# INLINE lmap #-}+  rmap = fmap+  {-# INLINE rmap #-}+  Reviewed b .# _ = Reviewed b+  {-# INLINE ( .# ) #-}+  ( #. ) _ = unsafeCoerce+  {-# INLINE ( #. ) #-}++type AReview s t a b = Overloaded Reviewed Identity s t a b++review :: AReview s t a b -> b -> t+review p = runIdentity #. runReviewed #. p .# Reviewed .# Identity+{-# INLINE review #-}++infixr 8 #+( # ) :: AReview s t a b -> b -> t+( # ) = review+{-# INLINE ( # ) #-}++------------------------------------------------------------------------++type Lens s t a b = forall f. Functor f => Overloaded (->) f s t a b+type Lens' s a = Lens s s a a++lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b+lens sa sbt afb s = sbt s <$> afb (sa s)+{-# INLINE lens #-}++------------------------------------------------------------------------++type Getting r s a = Overloaded (->) (Const r) s s a a++view :: Getting a s a -> s -> a+view l s = getConst (l Const s)+{-# INLINE view #-}++infixl 8 ^.+(^.) :: s -> Getting a s a -> a+(^.) = flip view+{-# INLINE (^.) #-}++------------------------------------------------------------------------++type Setter s t a b = Overloaded (->) Identity s t a b++set :: Setter s t a b -> b -> s -> t+set l b = runIdentity #. l (\ _ -> Identity b)+{-# INLINE set #-}++assign :: (MonadState s m) => Setter s s a b -> b -> m ()+assign l b = State.modify (set l b)+{-# INLINE assign #-}++infix 4 .=+(.=) :: (MonadState s m) => Setter s s a b -> b -> m ()+(.=) = assign+{-# INLINE (.=) #-}+
src/Data/Thyme.hs view
@@ -4,13 +4,12 @@ -- '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.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.+-- Conversions are provided as @Iso'@s from the+-- <http://hackage.haskell.org/package/lens lens> package, while+-- 'Data.AdditiveGroup.AdditiveGroup', 'Data.VectorSpace.VectorSpace' and+-- 'Data.AffineSpace.AffineSpace' from+-- <http://hackage.haskell.org/package/vector-space vector-space> allow for+-- more principled operations instead of 'Num', 'Fractional' & al. -- -- Thyme uses strict and unpacked tuples throughout, e.g. 'YearMonthDay' or -- 'Data.Thyme.Calendar.WeekDate.WeekDate'. Descriptive 'Int' synonyms such
src/Data/Thyme/Calendar.hs view
@@ -1,14 +1,13 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-orphans #-}+#include "thyme.h"  -- | 'UTCTime' is not Y294K-compliant, and 'Bounded' instances for the -- various calendar types reflect this fact. That said, the calendar -- calculations by themselves work perfectly fine for a wider range of -- dates, subject to the size of 'Int' for your platform.- module Data.Thyme.Calendar     ( Years, Months, Days     -- * Days@@ -23,12 +22,13 @@  import Prelude hiding ((.)) import Control.Applicative+import Control.Arrow import Control.Category import Control.Lens+import Control.Monad import Data.AdditiveGroup import Data.Thyme.Calendar.Internal import Data.Thyme.Clock.Internal-import Data.Thyme.TH import System.Random import Test.QuickCheck @@ -43,23 +43,29 @@     maxBound = maxBound ^. gregorian  instance Random Day where-    randomR r = over _1 (^. _utctDay) . randomR range where+    randomR r = first (^. _utctDay) . randomR (range r) where         -- upper bound is one Micro second before the next day-        range = r & _2 %~ succ & both %~ toMidnight & _2 %~ pred+        range = toMidnight *** pred . toMidnight . succ         toMidnight = (utcTime #) . flip UTCTime zeroV     random = randomR (minBound, maxBound)  instance Random YearMonthDay where     randomR = randomIsoR gregorian-    random = over _1 (^. gregorian) . random+    random = first (^. gregorian) . random  instance Arbitrary Day where     arbitrary = ModifiedJulianDay-        <$> choose ((minBound, maxBound) & both %~ toModifiedJulianDay)+        <$> choose (join (***) toModifiedJulianDay (minBound, maxBound))+    shrink (ModifiedJulianDay mjd) = ModifiedJulianDay <$> shrink mjd  instance Arbitrary YearMonthDay where     arbitrary = view gregorian <$> arbitrary+    shrink ymd = view gregorian <$> shrink (gregorian # ymd) +instance CoArbitrary YearMonthDay where+    coarbitrary (YearMonthDay y m d)+        = coarbitrary y . coarbitrary m . coarbitrary d+ ------------------------------------------------------------------------  {-# INLINE gregorianMonthLength #-}@@ -97,5 +103,7 @@ gregorianYearsRollover n (YearMonthDay y m d) = YearMonthDay (y + n) m d  -- * Lenses-thymeLenses ''YearMonthDay+LENS(YearMonthDay,ymdYear,Year)+LENS(YearMonthDay,ymdMonth,Month)+LENS(YearMonthDay,ymdDay,DayOfMonth)
src/Data/Thyme/Calendar/Internal.hs view
@@ -2,7 +2,9 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MagicHash #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_HADDOCK hide #-}@@ -13,6 +15,7 @@  import Prelude import Control.Applicative+import Control.Arrow import Control.DeepSeq import Control.Lens import Control.Monad@@ -24,6 +27,8 @@ import Data.Vector.Unboxed (Vector) import qualified Data.Vector.Unboxed as V import GHC.Generics (Generic)+import GHC.Prim+import GHC.Types import System.Random import Test.QuickCheck @@ -35,7 +40,7 @@ -- the day 1858-11-17. newtype Day = ModifiedJulianDay     { toModifiedJulianDay :: Int-    } deriving (INSTANCES_NEWTYPE)+    } deriving (INSTANCES_NEWTYPE, CoArbitrary)  instance AffineSpace Day where     type Diff Day = Days@@ -99,10 +104,15 @@ ------------------------------------------------------------------------  -- | Gregorian leap year?-{-# INLINE isLeapYear #-} isLeapYear :: Year -> Bool-isLeapYear y = mod y 4 == 0 && (mod y 400 == 0 || mod y 100 /= 0)+isLeapYear (I# y#) = isLeapYear# y# +-- | INTERNAL: avoid GHC duplicating code for each of the possibilities.+{-# NOINLINE isLeapYear# #-}+isLeapYear# :: Int# -> Bool+isLeapYear# y# = remInt# y# 4# ==# 0#+    && (remInt# y# 400# ==# 0# || remInt# y# 100# /=# 0#)+ type DayOfYear = Int data OrdinalDate = OrdinalDate     { odYear :: {-# UNPACK #-}!Year@@ -151,24 +161,24 @@ {-# NOINLINE monthDays #-} monthDays :: Vector ({-Month-}Int8, {-DayOfMonth-}Int8) monthDays = V.generate 365 go where-    first = V.prescanl' (+) 0 monthLengths+    dom01 = 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)+        m = maybe 12 id $ V.findIndex (yd <) dom01+        d = succ yd - V.unsafeIndex dom01 (pred m)  {-# ANN monthDaysLeap "HLint: ignore Use fromMaybe" #-} {-# NOINLINE monthDaysLeap #-} monthDaysLeap :: Vector ({-Month-}Int8, {-DayOfMonth-}Int8) monthDaysLeap = V.generate 366 go where-    first = V.prescanl' (+) 0 monthLengthsLeap+    dom01 = 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)+        m = maybe 12 id $ V.findIndex (yd <) dom01+        d = succ yd - V.unsafeIndex dom01 (pred m)  -- | No good home for this within the current hierarchy. This will do. {-# INLINEABLE randomIsoR #-} randomIsoR :: (Random s, RandomGen g) => Iso' s a -> (a, a) -> g -> (a, g)-randomIsoR l r = over _1 (^. l) . randomR (over both (l #) r)+randomIsoR l (x, y) = first (^. l) . randomR (l # x, l # y)  ------------------------------------------------------------------------ @@ -190,6 +200,10 @@  instance Arbitrary MonthDay where     arbitrary = choose (minBound, maxBound)+    shrink md = view (monthDay True) <$> shrink (monthDay True # md)++instance CoArbitrary MonthDay where+    coarbitrary (MonthDay m d) = coarbitrary m . coarbitrary d  -- | Convert between day of year in the Gregorian or Julian calendars, and -- month and day of month. First arg is leap year flag.
src/Data/Thyme/Calendar/MonthDay.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}+#include "thyme.h"  -- | Julian or Gregorian. module Data.Thyme.Calendar.MonthDay@@ -8,9 +10,10 @@     ) where  import Prelude+import Control.Lens import Data.Thyme.Calendar.Internal-import Data.Thyme.TH  -- * Lenses-thymeLenses ''MonthDay+LENS(MonthDay,mdMonth,Month)+LENS(MonthDay,mdDay,DayOfMonth)
src/Data/Thyme/Calendar/OrdinalDate.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-orphans #-}+#include "thyme.h"  -- | ISO 8601 Ordinal Date format- module Data.Thyme.Calendar.OrdinalDate     ( Year, isLeapYear     , DayOfYear, OrdinalDate (..), ordinalDate@@ -11,11 +12,11 @@  import Prelude import Control.Applicative+import Control.Arrow import Control.Lens import Control.Monad import Data.Thyme.Calendar import Data.Thyme.Calendar.Internal-import Data.Thyme.TH import System.Random import Test.QuickCheck @@ -25,16 +26,21 @@  instance Random OrdinalDate where     randomR = randomIsoR ordinalDate-    random = over _1 (^. ordinalDate) . random+    random = first (^. ordinalDate) . random  instance Arbitrary OrdinalDate where     arbitrary = view ordinalDate <$> arbitrary+    shrink od = view ordinalDate <$> shrink (ordinalDate # od) +instance CoArbitrary OrdinalDate where+    coarbitrary (OrdinalDate y d) = coarbitrary y . coarbitrary d+ {-# INLINE ordinalDateValid #-} ordinalDateValid :: OrdinalDate -> Maybe Day ordinalDateValid od@(OrdinalDate y d) = ordinalDate # od     <$ guard (1 <= d && d <= if isLeapYear y then 366 else 365)  -- * Lenses-thymeLenses ''OrdinalDate+LENS(OrdinalDate,odYear,Year)+LENS(OrdinalDate,odDay,DayOfYear)
src/Data/Thyme/Calendar/WeekDate.hs view
@@ -1,5 +1,7 @@-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-orphans #-}+#include "thyme.h"  -- | Various Week Date formats module Data.Thyme.Calendar.WeekDate@@ -15,10 +17,10 @@  import Prelude import Control.Applicative+import Control.Arrow import Control.Lens import Data.Thyme.Calendar.OrdinalDate import Data.Thyme.Calendar.Internal-import Data.Thyme.TH import System.Random import Test.QuickCheck @@ -36,27 +38,51 @@  instance Random WeekDate where     randomR = randomIsoR weekDate-    random = over _1 (^. weekDate) . random+    random = first (^. weekDate) . random  instance Random SundayWeek where     randomR = randomIsoR sundayWeek-    random = over _1 (^. sundayWeek) . random+    random = first (^. sundayWeek) . random  instance Random MondayWeek where     randomR = randomIsoR mondayWeek-    random = over _1 (^. mondayWeek) . random+    random = first (^. mondayWeek) . random  instance Arbitrary WeekDate where     arbitrary = view weekDate <$> arbitrary+    shrink wd = view weekDate <$> shrink (weekDate # wd)  instance Arbitrary SundayWeek where     arbitrary = view sundayWeek <$> arbitrary+    shrink sw = view sundayWeek <$> shrink (sundayWeek # sw)  instance Arbitrary MondayWeek where     arbitrary = view mondayWeek <$> arbitrary+    shrink mw = view mondayWeek <$> shrink (mondayWeek # mw) +instance CoArbitrary WeekDate where+    coarbitrary (WeekDate y w d)+        = coarbitrary y . coarbitrary w . coarbitrary d++instance CoArbitrary SundayWeek where+    coarbitrary (SundayWeek y w d)+        = coarbitrary y . coarbitrary w . coarbitrary d++instance CoArbitrary MondayWeek where+    coarbitrary (MondayWeek y w d)+        = coarbitrary y . coarbitrary w . coarbitrary d+ -- * Lenses-thymeLenses ''WeekDate-thymeLenses ''SundayWeek-thymeLenses ''MondayWeek++LENS(WeekDate,wdYear,Year)+LENS(WeekDate,wdWeek,WeekOfYear)+LENS(WeekDate,wdDay,DayOfWeek)++LENS(SundayWeek,swYear,Year)+LENS(SundayWeek,swWeek,WeekOfYear)+LENS(SundayWeek,swDay,DayOfWeek)++LENS(MondayWeek,mwYear,Year)+LENS(MondayWeek,mwWeek,WeekOfYear)+LENS(MondayWeek,mwDay,DayOfWeek)
src/Data/Thyme/Calendar/WeekdayOfMonth.hs view
@@ -1,15 +1,15 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-}- #include "thyme.h"  module Data.Thyme.Calendar.WeekdayOfMonth where  import Prelude import Control.Applicative+import Control.Arrow import Control.DeepSeq import Control.Lens import Control.Monad@@ -17,7 +17,6 @@ import Data.Data import Data.Thyme.Calendar import Data.Thyme.Calendar.Internal-import Data.Thyme.TH import GHC.Generics (Generic) import System.Random import Test.QuickCheck@@ -37,11 +36,17 @@  instance Random WeekdayOfMonth where     randomR = randomIsoR weekdayOfMonth-    random = over _1 (^. weekdayOfMonth) . random+    random = first (^. weekdayOfMonth) . random  instance Arbitrary WeekdayOfMonth where     arbitrary = view weekdayOfMonth <$> arbitrary+    shrink wom = view weekdayOfMonth <$> shrink (weekdayOfMonth # wom) +instance CoArbitrary WeekdayOfMonth where+    coarbitrary (WeekdayOfMonth y m n d)+        = coarbitrary y . coarbitrary m+        . coarbitrary n . coarbitrary d+ {-# INLINE weekdayOfMonth #-} weekdayOfMonth :: Iso' Day WeekdayOfMonth weekdayOfMonth = iso toWeekday fromWeekday where@@ -77,4 +82,8 @@     offset = (abs n - 1) * 7 + if wo < 0 then wo + 7 else wo  -- * Lenses-thymeLenses ''WeekdayOfMonth+LENS(WeekdayOfMonth,womYear,Year)+LENS(WeekdayOfMonth,womMonth,Month)+LENS(WeekdayOfMonth,womNth,Int)+LENS(WeekdayOfMonth,womDayOfWeek,DayOfWeek)+
− src/Data/Thyme/Clock/POSIX.hs 
@@ -1,26 +0,0 @@-module Data.Thyme.Clock.POSIX-    ( posixDayLength-    , module Data.Thyme.Clock.POSIX-    ) where--import Prelude-import Control.Lens-import Data.AdditiveGroup-import Data.Thyme.Internal.Micro-import Data.Thyme.Clock.Internal-import qualified Data.Time.Clock.POSIX as T-import Data.VectorSpace--type POSIXTime = NominalDiffTime--{-# INLINE posixTime #-}-posixTime :: Iso' UTCTime POSIXTime-posixTime = iso (\ (UTCRep t) -> t ^-^ unixEpoch)-        (UTCRep . (^+^) unixEpoch) where-    unixEpoch = {-ModifiedJulianDay-}40587 *^ posixDayLength---- TODO: reimplement without 'T.getPOSIXTime' to avoid 'Integer'?-{-# INLINE getPOSIXTime #-}-getPOSIXTime :: IO POSIXTime-getPOSIXTime = fmap (NominalDiffTime . toMicro . toRational) T.getPOSIXTime-
+ src/Data/Thyme/Clock/POSIX.hsc view
@@ -0,0 +1,59 @@+{-# LANGUAGE ForeignFunctionInterface #-}++#ifndef mingw32_HOST_OS+#include <sys/time.h>+#endif++module Data.Thyme.Clock.POSIX+    ( posixDayLength+    , module Data.Thyme.Clock.POSIX+    ) where++import Prelude+import Control.Lens+import Data.AdditiveGroup+import Data.Thyme.Internal.Micro+import Data.Thyme.Clock.Internal+import Data.VectorSpace++#ifdef mingw32_HOST_OS+import System.Win32.Time+#else+import Foreign.C.Error (throwErrnoIfMinus1_)+import Foreign.C.Types+import Foreign.Marshal.Alloc (allocaBytes)+import Foreign.Ptr (Ptr, nullPtr)+import Foreign.Storable+#endif++type POSIXTime = NominalDiffTime++{-# INLINE posixTime #-}+posixTime :: Iso' UTCTime POSIXTime+posixTime = iso (\ (UTCRep t) -> t ^-^ unixEpoch)+        (UTCRep . (^+^) unixEpoch) where+    unixEpoch = {-ModifiedJulianDay-}40587 *^ posixDayLength++{-# INLINE getPOSIXTime #-}+getPOSIXTime :: IO POSIXTime+#ifdef mingw32_HOST_OS++getPOSIXTime = do+    FILETIME ft <- System.Win32.Time.getSystemTimeAsFileTime+    return . NominalDiffTime . Micro $+        fromIntegral ft - 116444736000000000{-win32_epoch_adjust-}++#else++getPOSIXTime = allocaBytes #{size struct timeval} $ \ ptv -> do+    throwErrnoIfMinus1_ "gettimeofday" $ gettimeofday ptv nullPtr+    sec <- #{peek struct timeval, tv_sec} ptv :: IO CLong+    usec <- #{peek struct timeval, tv_usec} ptv :: IO CLong+    return . NominalDiffTime . Micro $+        1000000 * fromIntegral sec + fromIntegral usec++foreign import ccall unsafe "time.h gettimeofday"+    gettimeofday :: Ptr () -> Ptr () -> IO CInt++#endif+
src/Data/Thyme/Clock/TAI.hs view
@@ -8,6 +8,9 @@ {-# LANGUAGE ViewPatterns #-}  #include "thyme.h"+#if HLINT+#include "cabal_macros.h"+#endif  module Data.Thyme.Clock.TAI     ( AbsoluteTime
src/Data/Thyme/Format.hs view
@@ -1,9 +1,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-orphans #-}+#include "thyme.h"  module Data.Thyme.Format     ( FormatTime (..)@@ -19,8 +19,8 @@ import Prelude import Control.Applicative import Control.Lens-import Control.Monad.Trans.Class-import Control.Monad.Trans.State.Strict+import Control.Monad.Trans+import Control.Monad.State.Strict import Data.Attoparsec.ByteString.Char8 (Parser) import qualified Data.Attoparsec.ByteString.Char8 as P import Data.Bits@@ -35,7 +35,6 @@ import Data.Thyme.Clock.TAI import Data.Thyme.Format.Internal import Data.Thyme.LocalTime-import Data.Thyme.TH import Data.VectorSpace import System.Locale @@ -276,7 +275,20 @@     , tpTimeZone :: !TimeZone     } deriving (Show) -thymeLenses ''TimeParse+LENS(TimeParse,tpCentury,Int)+LENS(TimeParse,tpCenturyYear,Int{-YearOfCentury-})+LENS(TimeParse,tpMonth,Month)+LENS(TimeParse,tpWeekOfYear,WeekOfYear)+LENS(TimeParse,tpDayOfMonth,DayOfMonth)+LENS(TimeParse,tpDayOfWeek,DayOfWeek)+LENS(TimeParse,tpDayOfYear,DayOfYear)+LENS(TimeParse,tpFlags,Int{-BitSet TimeFlag-})+LENS(TimeParse,tpHour,Hour)+LENS(TimeParse,tpMinute,Minute)+LENS(TimeParse,tpSecond,Int)+LENS(TimeParse,tpSecFrac,DiffTime)+LENS(TimeParse,tpPOSIXTime,POSIXTime)+LENS(TimeParse,tpTimeZone,TimeZone)  {-# INLINE flag #-} flag :: TimeFlag -> Lens' TimeParse Bool@@ -570,7 +582,7 @@     {-# INLINE buildTime #-}     buildTime tp@TimeParse {..} = if tp ^. flag IsPOSIXTime         then posixTime # tpPOSIXTime-        else buildTime tp ^. from zonedTime . _2+        else snd $ buildTime tp ^. from zonedTime  instance ParseTime UniversalTime where     {-# INLINE buildTime #-}
src/Data/Thyme/Format/Human.hs view
@@ -1,7 +1,8 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-}+#include "thyme.h"  module Data.Thyme.Format.Human     ( humanTimeDiff@@ -11,9 +12,9 @@     ) where  import Prelude-import Control.Arrow import Control.Applicative-import Control.Lens hiding (singular)+import Control.Arrow+import Control.Lens import Control.Monad import Data.AdditiveGroup import Data.AffineSpace@@ -21,15 +22,14 @@ import Data.Thyme.Internal.Micro import Data.Monoid import Data.Thyme.Clock.Internal-import Data.Thyme.TH import Data.VectorSpace  data Unit = Unit     { unit :: Micro-    , singular :: ShowS+    , single :: ShowS     , plural :: ShowS     }-thymeLenses ''Unit+LENS(Unit,plural,ShowS)  -- | Display 'DiffTime' or 'NominalDiffTime' in a human-readable form. {-# INLINE humanTimeDiff #-}@@ -63,7 +63,7 @@         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+    inflection = if n == 1 then single else plural  units :: [Unit] units = scanl (&)@@ -82,6 +82,6 @@     , const (Unit maxBound id id) -- upper bound needed for humanTimeDiffs.diff     ] where     times :: String -> Rational -> Unit -> Unit-    times ((++) . (:) ' ' -> singular) r Unit {unit}-        = Unit {unit = r *^ unit, plural = singular . (:) 's', ..}+    times ((++) . (:) ' ' -> single) r Unit {unit}+        = Unit {unit = r *^ unit, plural = single . (:) 's', ..}
src/Data/Thyme/Format/Internal.hs view
@@ -2,6 +2,10 @@ {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_HADDOCK hide #-} +#if HLINT+#include "cabal_macros.h"+#endif+ module Data.Thyme.Format.Internal where  import Prelude
src/Data/Thyme/Internal/Micro.hs view
@@ -60,10 +60,6 @@         return . Micro . sign $ s * 1000000 + us #endif -{-# INLINE toMicro #-}-toMicro :: Rational -> Micro-toMicro r = Micro (fromInteger $ 1000000 * numerator r `div` denominator r)- {-# INLINE microQuotRem #-} {-# INLINE microDivMod #-} microQuotRem, microDivMod :: Micro -> Micro -> (Int64, Micro)@@ -82,7 +78,13 @@     type Scalar Micro = Rational     {-# INLINE (*^) #-}     s *^ Micro a = Micro . fromInteger $-        toInteger a * numerator s `quot` denominator s+        case compare (2 * abs r) (denominator s) of+            LT -> n+            EQ -> if even n then n else m+            GT -> m+      where+        (n, r) = quotRem (toInteger a * numerator s) (denominator s)+        m = if r < 0 then n - 1 else n + 1  instance HasBasis Micro where     type Basis Micro = ()
src/Data/Thyme/LocalTime.hs view
@@ -1,21 +1,338 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} -module Data.Thyme.LocalTime-    ( module Data.Thyme.LocalTime.TimeZone-    , module Data.Thyme.LocalTime.Internal-    , module Data.Thyme.LocalTime-    ) where+#include "thyme.h" -import Prelude+module Data.Thyme.LocalTime where++import Prelude hiding ((.))+import Control.Applicative+import Control.Arrow+import Control.Category hiding (id)+import Control.DeepSeq import Control.Lens+import Control.Monad+import Data.AffineSpace+import Data.Data+import Data.Thyme.Internal.Micro+import Data.Thyme.Calendar+import Data.Thyme.Calendar.Internal import Data.Thyme.Clock-import Data.Thyme.LocalTime.Internal-import Data.Thyme.LocalTime.TimeZone-import Data.Thyme.TH+import Data.Thyme.Clock.Internal+import Data.Thyme.Format.Internal+import qualified Data.Time as T+import Data.VectorSpace+import GHC.Generics (Generic)+import System.Random+import Test.QuickCheck +type Minutes = Int+type Hours = Int++------------------------------------------------------------------------+-- * Time zones++data TimeZone = TimeZone+    { timeZoneMinutes :: {-# UNPACK #-}!Minutes+    , timeZoneSummerOnly :: !Bool+    , timeZoneName :: String+    } deriving (INSTANCES_USUAL)++instance NFData TimeZone++#if SHOW_INTERNAL+deriving instance Show TimeZone+#else+instance Show TimeZone where+    show tz@TimeZone {..} = if null timeZoneName+        then timeZoneOffsetString tz else timeZoneName+#endif++instance Bounded TimeZone where+    minBound = TimeZone (-12 * 60) minBound "AAAA"+    maxBound = TimeZone (13 * 60) maxBound "ZZZZ"++instance Random TimeZone where+    randomR (l, u) g0 = (TimeZone minutes summer name, g3) where+        (minutes, g1) = randomR (timeZoneMinutes l, timeZoneMinutes u) g0+        (summer, g2) = randomR (timeZoneSummerOnly l, timeZoneSummerOnly u) g1+        -- slightly dubious interpretation of ‘range’+        (name, g3) = foldr randChar ([], g2) . take 4 $ zipWith (,)+            (timeZoneName l ++ "AAAA") (timeZoneName u ++ "ZZZZ")+        randChar nR (ns, g) = (: ns) `first` randomR nR g+    random = randomR (minBound, maxBound)++instance Arbitrary TimeZone where+    arbitrary = choose (minBound, maxBound)+    shrink tz@TimeZone {..}+        = [ tz {timeZoneSummerOnly = s} | s <- shrink timeZoneSummerOnly ]+        ++ [ tz {timeZoneMinutes = m} | m <- shrink timeZoneMinutes ]+        ++ [ tz {timeZoneName = n} | n <- shrink timeZoneName ]++instance CoArbitrary TimeZone where+    coarbitrary (TimeZone m s n)+        = coarbitrary m . coarbitrary s . coarbitrary n++-- | Text representing the offset of this timezone, e.g. \"-0800\" or+-- \"+0400\" (like %z in 'formatTime')+{-# INLINEABLE timeZoneOffsetString #-}+timeZoneOffsetString :: TimeZone -> String+timeZoneOffsetString TimeZone {..} = sign : (shows02 h . shows02 m) "" where+    (h, m) = divMod offset 60+    (sign, offset) = if timeZoneMinutes < 0+        then ('-', negate timeZoneMinutes) else ('+', timeZoneMinutes)++-- | Create a nameless non-summer timezone for this number of minutes+minutesToTimeZone :: Minutes -> TimeZone+minutesToTimeZone m = TimeZone m False ""++-- | Create a nameless non-summer timezone for this number of hours+hoursToTimeZone :: Hours -> TimeZone+hoursToTimeZone i = minutesToTimeZone (60 * i)++utc :: TimeZone+utc = TimeZone 0 False "UTC"++{-# INLINEABLE getTimeZone #-}+getTimeZone :: UTCTime -> IO TimeZone+getTimeZone t = thyme `fmap` T.getTimeZone (T.UTCTime day $ toSeconds dt) where+    day = T.ModifiedJulianDay (toInteger mjd)+    UTCTime (ModifiedJulianDay mjd) dt = t ^. utcTime+    thyme T.TimeZone {..} = TimeZone {..}++{-# INLINE getCurrentTimeZone #-}+getCurrentTimeZone :: IO TimeZone+getCurrentTimeZone = getCurrentTime >>= getTimeZone++------------------------------------------------------------------------+-- * Time of day++type Hour = Int+type Minute = Int+data TimeOfDay = TimeOfDay+    { todHour :: {-# UNPACK #-}!Hour+    , todMin :: {-# UNPACK #-}!Minute+    , todSec :: {-# UNPACK #-}!DiffTime+    } deriving (INSTANCES_USUAL)++instance NFData TimeOfDay++#if SHOW_INTERNAL+deriving instance Show TimeOfDay+#else+instance Show TimeOfDay where+    showsPrec _ (TimeOfDay h m (DiffTime s))+            = shows02 h . (:) ':' . shows02 m . (:) ':'+            . shows02 (fromIntegral si) . frac where+        (si, Micro su) = microQuotRem s (Micro 1000000)+        frac = if su == 0 then id else (:) '.' . fills06 su . drops0 su+#endif++instance Bounded TimeOfDay where+    minBound = TimeOfDay 0 0 zeroV+    maxBound = TimeOfDay 23 59 (microseconds # 60999999)++instance Random TimeOfDay where+    randomR = randomIsoR timeOfDay+    random = first (^. timeOfDay) . random++instance Arbitrary TimeOfDay where+    arbitrary = do+        h <- choose (0, 23)+        m <- choose (0, 59)+        let DiffTime ml = minuteLength h m+        TimeOfDay h m . DiffTime <$> choose (zeroV, pred ml)+    shrink tod = view timeOfDay . (^+^) noon+            <$> shrink (timeOfDay # tod ^-^ noon) where+        noon = timeOfDay # midday -- shrink towards midday++instance CoArbitrary TimeOfDay where+    coarbitrary (TimeOfDay h m s)+        = coarbitrary h . coarbitrary m . coarbitrary s++{-# INLINE minuteLength #-}+minuteLength :: Hour -> Minute -> DiffTime+minuteLength h m = fromSeconds' $ if h == 23 && m == 59 then 61 else 60++-- | Hour zero+midnight :: TimeOfDay+midnight = TimeOfDay 0 0 zeroV++-- | Hour twelve+midday :: TimeOfDay+midday = TimeOfDay 12 0 zeroV++{-# INLINE makeTimeOfDayValid #-}+makeTimeOfDayValid :: Hour -> Minute -> DiffTime -> Maybe TimeOfDay+makeTimeOfDayValid h m s = TimeOfDay h m s+    <$ guard (0 <= h && h <= 23 && 0 <= m && m <= 59)+    <* guard (zeroV <= s && s < minuteLength h m)++{-# INLINE timeOfDay #-}+timeOfDay :: Iso' DiffTime TimeOfDay+timeOfDay = iso fromDiff toDiff where++    {-# INLINEABLE fromDiff #-}+    fromDiff :: DiffTime -> TimeOfDay+    fromDiff (DiffTime t) = TimeOfDay+            (fromIntegral h) (fromIntegral m) (DiffTime s) where+        (h, ms) = microQuotRem t (Micro 3600000000)+        (m, s) = microQuotRem ms (Micro 60000000)++    {-# INLINEABLE toDiff #-}+    toDiff :: TimeOfDay -> DiffTime+    toDiff (TimeOfDay h m s) = s+        ^+^ fromIntegral m *^ DiffTime (Micro 60000000)+        ^+^ fromIntegral h *^ DiffTime (Micro 3600000000)++-- | Add some minutes to a 'TimeOfDay'; result comes with a day adjustment.+{-# INLINE addMinutes #-}+addMinutes :: Minutes -> TimeOfDay -> (Days, TimeOfDay)+addMinutes dm (TimeOfDay h m s) = (dd, TimeOfDay h' m' s) where+    (dd, h') = divMod (h + dh) 24+    (dh, m') = divMod (m + dm) 60++{-# INLINE dayFraction #-}+dayFraction :: Iso' TimeOfDay Rational+dayFraction = from timeOfDay . iso toRatio fromRatio where++    {-# INLINEABLE toRatio #-}+    toRatio :: DiffTime -> Rational+    toRatio t = toSeconds t / toSeconds posixDayLength++    {-# INLINEABLE fromRatio #-}+    fromRatio :: Rational -> DiffTime+    fromRatio ((*^ posixDayLength) -> NominalDiffTime r) = DiffTime r++------------------------------------------------------------------------+-- * Local Time++data LocalTime = LocalTime+    { localDay :: {-# UNPACK #-}!Day+    , localTimeOfDay :: {-only 3 words…-} {-# UNPACK #-}!TimeOfDay+    } deriving (INSTANCES_USUAL)++instance NFData LocalTime++#if SHOW_INTERNAL+deriving instance Show LocalTime+#else+instance Show LocalTime where+    showsPrec p (LocalTime d t) = showsPrec p d . (:) ' ' . showsPrec p t+#endif++instance Bounded LocalTime where+    minBound = minBound ^. utcLocalTime maxBound+    maxBound = maxBound ^. utcLocalTime minBound++instance Random LocalTime where+    randomR = randomIsoR (utcLocalTime utc)+    random = randomR (minBound, maxBound)++instance Arbitrary LocalTime where+    arbitrary = choose (minBound, maxBound)+    shrink lt@LocalTime {..}+        = [ lt {localDay = d} | d <- shrink localDay ]+        ++ [ lt {localTimeOfDay = d} | d <- shrink localTimeOfDay ]++instance CoArbitrary LocalTime where+    coarbitrary (LocalTime d t) = coarbitrary d . coarbitrary t++{-# INLINE utcLocalTime #-}+utcLocalTime :: TimeZone -> Iso' UTCTime LocalTime+utcLocalTime TimeZone {..} = utcTime . iso localise globalise where++    {-# INLINEABLE localise #-}+    localise :: UTCView -> LocalTime+    localise (UTCTime day dt) = LocalTime (day .+^ dd) tod where+        (dd, tod) = addMinutes timeZoneMinutes (dt ^. timeOfDay)++    {-# INLINEABLE globalise #-}+    globalise :: LocalTime -> UTCView+    globalise (LocalTime day tod) = UTCTime (day .+^ dd)+            (timeOfDay # utcToD) where+        (dd, utcToD) = addMinutes (negate timeZoneMinutes) tod++{-# INLINE ut1LocalTime #-}+ut1LocalTime :: Rational -> Iso' UniversalTime LocalTime+ut1LocalTime long = iso localise globalise where+    NominalDiffTime posixDay@(Micro usDay) = posixDayLength++    {-# INLINEABLE localise #-}+    localise :: UniversalTime -> LocalTime+    localise (UniversalRep (NominalDiffTime t)) = LocalTime+            (ModifiedJulianDay $ fromIntegral day)+            (DiffTime dt ^. timeOfDay) where+        (day, dt) = microDivMod (t ^+^ (long / 360) *^ posixDay) posixDay++    {-# INLINEABLE globalise #-}+    globalise :: LocalTime -> UniversalTime+    globalise (LocalTime day tod) = UniversalRep . NominalDiffTime $+            Micro (mjd * usDay) ^+^ dt ^-^ (long / 360) *^ posixDay where+        ModifiedJulianDay (fromIntegral -> mjd) = day+        DiffTime dt = timeOfDay # tod++------------------------------------------------------------------------+-- * Zoned Time++data ZonedTime = ZonedTime+    { zonedTimeToLocalTime :: {-only 4 words…-} {-# UNPACK #-}!LocalTime+    , zonedTimeZone :: !TimeZone+    } deriving (INSTANCES_USUAL)++instance NFData ZonedTime where+    rnf ZonedTime {..} = rnf zonedTimeZone++instance Bounded ZonedTime where+    minBound = ZonedTime minBound maxBound+    maxBound = ZonedTime maxBound minBound++instance Random ZonedTime where+    randomR (l, u) g0 = (view zonedTime . (,) tz)+            `first` randomR (l', u') g1 where+        (tz, g1) = random g0 -- ignore TimeZone from l and u+        l' = snd $ zonedTime # l+        u' = snd $ zonedTime # u+    random = randomR (minBound, maxBound)++instance Arbitrary ZonedTime where+    arbitrary = choose (minBound, maxBound)+    shrink zt@ZonedTime {..}+        = [ zt {zonedTimeToLocalTime = lt} | lt <- shrink zonedTimeToLocalTime ]+        ++ [ zt {zonedTimeZone = tz} | tz <- shrink zonedTimeZone ]++instance CoArbitrary ZonedTime where+    coarbitrary (ZonedTime lt tz) = coarbitrary lt . coarbitrary tz++{-# INLINE zonedTime #-}+zonedTime :: Iso' (TimeZone, UTCTime) ZonedTime+zonedTime = iso toZoned fromZoned where++    {-# INLINE toZoned #-}+    toZoned :: (TimeZone, UTCTime) -> ZonedTime+    toZoned (tz, time) = ZonedTime (time ^. utcLocalTime tz) tz++    {-# INLINE fromZoned #-}+    fromZoned :: ZonedTime -> (TimeZone, UTCTime)+    fromZoned (ZonedTime lt tz) = (tz, utcLocalTime tz # lt)++#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+ {-# INLINE getZonedTime #-} getZonedTime :: IO ZonedTime getZonedTime = utcToLocalZonedTime =<< getCurrentTime@@ -26,11 +343,19 @@     tz <- getTimeZone time     return $ (tz, time) ^. zonedTime ------------------------------------------------------------------------- -- * Lenses -thymeLenses ''TimeZone-thymeLenses ''TimeOfDay-thymeLenses ''LocalTime-thymeLenses ''ZonedTime+LENS(TimeZone,timeZoneMinutes,Minutes)+LENS(TimeZone,timeZoneSummerOnly,Bool)+LENS(TimeZone,timeZoneName,String)++LENS(TimeOfDay,todHour,Hour)+LENS(TimeOfDay,todMin,Minute)+LENS(TimeOfDay,todSec,DiffTime)++LENS(LocalTime,localDay,Day)+LENS(LocalTime,localTimeOfDay,TimeOfDay)++LENS(ZonedTime,zonedTimeToLocalTime,LocalTime)+LENS(ZonedTime,zonedTimeZone,TimeZone)
− src/Data/Thyme/LocalTime/Internal.hs 
@@ -1,214 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE ViewPatterns #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# OPTIONS_HADDOCK hide #-}--#include "thyme.h"--module Data.Thyme.LocalTime.Internal where--import Prelude hiding ((.))-import Control.Applicative-import Control.Category hiding (id)-import Control.DeepSeq-import Control.Lens-import Control.Monad-import Data.AffineSpace-import Data.Data-import Data.Thyme.Internal.Micro-import Data.Thyme.Calendar.Internal-import Data.Thyme.Clock.Internal-#if !SHOW_INTERNAL-import Data.Thyme.Format.Internal-#endif-import Data.Thyme.LocalTime.TimeZone-import Data.VectorSpace-import GHC.Generics (Generic)-import System.Random-import Test.QuickCheck----------------------------------------------------------------------------- * Time of day--type Hour = Int-type Minute = Int-data TimeOfDay = TimeOfDay-    { todHour :: {-# UNPACK #-}!Hour-    , todMin :: {-# UNPACK #-}!Minute-    , todSec :: {-# UNPACK #-}!DiffTime-    } deriving (INSTANCES_USUAL)--instance NFData TimeOfDay--#if SHOW_INTERNAL-deriving instance Show TimeOfDay-#else-instance Show TimeOfDay where-    showsPrec _ (TimeOfDay h m (DiffTime s))-            = shows02 h . (:) ':' . shows02 m . (:) ':'-            . shows02 (fromIntegral si) . frac where-        (si, Micro su) = microQuotRem s (Micro 1000000)-        frac = if su == 0 then id else (:) '.' . fills06 su . drops0 su-#endif--instance Bounded TimeOfDay where-    minBound = TimeOfDay 0 0 zeroV-    maxBound = TimeOfDay 23 59 (microseconds # 60999999)--instance Random TimeOfDay where-    randomR = randomIsoR timeOfDay-    random = over _1 (^. timeOfDay) . random--instance Arbitrary TimeOfDay where-    arbitrary = do-        h <- choose (0, 23)-        m <- choose (0, 59)-        let DiffTime ml = minuteLength h m-        TimeOfDay h m . DiffTime <$> choose (zeroV, pred ml)--{-# INLINE minuteLength #-}-minuteLength :: Hour -> Minute -> DiffTime-minuteLength h m = fromSeconds' $ if h == 23 && m == 59 then 61 else 60---- | Hour zero-midnight :: TimeOfDay-midnight = TimeOfDay 0 0 zeroV---- | Hour twelve-midday :: TimeOfDay-midday = TimeOfDay 12 0 zeroV--{-# INLINE makeTimeOfDayValid #-}-makeTimeOfDayValid :: Hour -> Minute -> DiffTime -> Maybe TimeOfDay-makeTimeOfDayValid h m s = TimeOfDay h m s-    <$ guard (0 <= h && h <= 23 && 0 <= m && m <= 59)-    <* guard (zeroV <= s && s < minuteLength h m)--{-# INLINE timeOfDay #-}-timeOfDay :: Iso' DiffTime TimeOfDay-timeOfDay = iso fromDiff toDiff where--    {-# INLINEABLE fromDiff #-}-    fromDiff :: DiffTime -> TimeOfDay-    fromDiff (DiffTime t) = TimeOfDay-            (fromIntegral h) (fromIntegral m) (DiffTime s) where-        (h, ms) = microQuotRem t (toMicro 3600)-        (m, s) = microQuotRem ms (toMicro 60)--    {-# INLINEABLE toDiff #-}-    toDiff :: TimeOfDay -> DiffTime-    toDiff (TimeOfDay h m s) = s-        ^+^ fromIntegral m *^ DiffTime (toMicro 60)-        ^+^ fromIntegral h *^ DiffTime (toMicro 3600)--type Minutes = Int---- | Add some minutes to a 'TimeOfDay'; result comes with a day adjustment.-{-# INLINE addMinutes #-}-addMinutes :: Minutes -> TimeOfDay -> (Days, TimeOfDay)-addMinutes dm (TimeOfDay h m s) = (dd, TimeOfDay h' m' s) where-    (dd, h') = divMod (h + dh) 24-    (dh, m') = divMod (m + dm) 60--{-# INLINE dayFraction #-}-dayFraction :: Iso' TimeOfDay Rational-dayFraction = from timeOfDay . iso toRatio fromRatio where--    {-# INLINEABLE toRatio #-}-    toRatio :: DiffTime -> Rational-    toRatio t = toSeconds t / toSeconds posixDayLength--    {-# INLINEABLE fromRatio #-}-    fromRatio :: Rational -> DiffTime-    fromRatio ((*^ posixDayLength) -> NominalDiffTime r) = DiffTime r----------------------------------------------------------------------------- * Local Time--data LocalTime = LocalTime-    { localDay :: {-# UNPACK #-}!Day-    , localTimeOfDay :: {-only 3 words…-} {-# UNPACK #-}!TimeOfDay-    } deriving (INSTANCES_USUAL)--instance NFData LocalTime--#if SHOW_INTERNAL-deriving instance Show LocalTime-#else-instance Show LocalTime where-    showsPrec p (LocalTime d t) = showsPrec p d . (:) ' ' . showsPrec p t-#endif--{-# INLINE utcLocalTime #-}-utcLocalTime :: TimeZone -> Iso' UTCTime LocalTime-utcLocalTime TimeZone {..} = utcTime . iso localise globalise where--    {-# INLINEABLE localise #-}-    localise :: UTCView -> LocalTime-    localise (UTCTime day dt) = LocalTime (day .+^ dd) tod where-        (dd, tod) = addMinutes timeZoneMinutes (dt ^. timeOfDay)--    {-# INLINEABLE globalise #-}-    globalise :: LocalTime -> UTCView-    globalise (LocalTime day tod) = UTCTime (day .+^ dd)-            (timeOfDay # utcToD) where-        (dd, utcToD) = addMinutes (negate timeZoneMinutes) tod--{-# INLINE ut1LocalTime #-}-ut1LocalTime :: Rational -> Iso' UniversalTime LocalTime-ut1LocalTime long = iso localise globalise where-    NominalDiffTime posixDay@(Micro usDay) = posixDayLength--    {-# INLINEABLE localise #-}-    localise :: UniversalTime -> LocalTime-    localise (UniversalRep (NominalDiffTime t)) = LocalTime-            (ModifiedJulianDay $ fromIntegral day)-            (DiffTime dt ^. timeOfDay) where-        (day, dt) = microDivMod (t ^+^ (long / 360) *^ posixDay) posixDay--    {-# INLINEABLE globalise #-}-    globalise :: LocalTime -> UniversalTime-    globalise (LocalTime day tod) = UniversalRep . NominalDiffTime $-            Micro (mjd * usDay) ^+^ dt ^-^ (long / 360) *^ posixDay where-        ModifiedJulianDay (fromIntegral -> mjd) = day-        DiffTime dt = timeOfDay # tod----------------------------------------------------------------------------- * Zoned Time--data ZonedTime = ZonedTime-    { zonedTimeToLocalTime :: {-only 4 words…-} {-# UNPACK #-}!LocalTime-    , zonedTimeZone :: !TimeZone-    } deriving (INSTANCES_USUAL)--instance NFData ZonedTime where-    rnf ZonedTime {..} = rnf zonedTimeZone--{-# INLINE zonedTime #-}-zonedTime :: Iso' (TimeZone, UTCTime) ZonedTime-zonedTime = iso toZoned fromZoned where--    {-# INLINE toZoned #-}-    toZoned :: (TimeZone, UTCTime) -> ZonedTime-    toZoned (tz, time) = ZonedTime (time ^. utcLocalTime tz) tz--    {-# INLINE fromZoned #-}-    fromZoned :: ZonedTime -> (TimeZone, UTCTime)-    fromZoned (ZonedTime lt tz) = (tz, utcLocalTime tz # lt)--#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 
@@ -1,27 +0,0 @@-module Data.Thyme.LocalTime.TimeZone (-    -- * Time zones-      T.TimeZone (..)-    , T.timeZoneOffsetString-    , T.timeZoneOffsetString'-    , T.minutesToTimeZone-    , T.hoursToTimeZone-    , T.utc-    , module Data.Thyme.LocalTime.TimeZone-    ) where--import Prelude-import Control.Lens-import Data.Thyme.Calendar-import Data.Thyme.Clock-import qualified Data.Time as T--{-# INLINEABLE getTimeZone #-}-getTimeZone :: UTCTime -> IO T.TimeZone-getTimeZone t = T.getTimeZone $ T.UTCTime day (toSeconds dt) where-    day = T.ModifiedJulianDay (toInteger mjd)-    UTCTime (ModifiedJulianDay mjd) dt = t ^. utcTime--{-# INLINE getCurrentTimeZone #-}-getCurrentTimeZone :: IO T.TimeZone-getCurrentTimeZone = getCurrentTime >>= getTimeZone-
− src/Data/Thyme/TH.hs 
@@ -1,12 +0,0 @@-{-# OPTIONS_HADDOCK hide #-}--module Data.Thyme.TH (thymeLenses) where--import Prelude-import Control.Lens-import Language.Haskell.TH--thymeLenses :: Name -> Q [Dec]-thymeLenses = makeLensesWith $ lensRules-    & lensField .~ Just . (:) '_'-
src/Data/Thyme/Time.hs view
@@ -66,7 +66,7 @@     {-# INLINE fromRational #-}     Micro a / Micro b = Micro (quot (a * 1000) (b `quot` 1000))     recip (Micro a) = Micro (quot 1000000 a)-    fromRational = toMicro+    fromRational r = Micro (round $ r * 1000000)  instance RealFrac Micro where     {-# INLINE properFraction #-}
src/Data/Thyme/Time/Core.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-}  -- | This module provides just the compatibility wrappers for the things@@ -73,7 +74,8 @@  instance Thyme T.TimeZone TimeZone where     {-# INLINE thyme #-}-    thyme = id+    thyme = iso (\ T.TimeZone {..} -> TimeZone {..})+        (\ TimeZone {..} -> T.TimeZone {..})  instance Thyme T.TimeOfDay TimeOfDay where     {-# INLINE thyme #-}
tests/bench.hs view
@@ -3,7 +3,7 @@ import Control.Applicative import Control.Lens import Control.Monad-import Control.Monad.IO.Class+import Control.Monad.Trans import Criterion import Criterion.Analysis import Criterion.Config
tests/hlint.hs view
@@ -7,8 +7,9 @@ main :: IO () main = (`unless` exitFailure) . null =<< hlint     [ "src", "tests"-    , "--cpp-define=HLINT"+    , "--cpp-define=HLINT=1"     , "--cpp-include=include"+    , "--cpp-include=dist/build/autogen"     , "--cpp-define=SHOW_INTERNAL=1"     , "-XNoUnboxedTuples"     , "-i", "Unused LANGUAGE pragma"
tests/rewrite.hs view
@@ -1,6 +1,10 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} +#if HLINT+#include "cabal_macros.h"+#endif+ import Prelude #if !MIN_VERSION_base(4,6,0)     hiding (catch)
tests/sanity.hs view
@@ -1,6 +1,10 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} +#if HLINT+#include "cabal_macros.h"+#endif+ import Prelude import Control.Lens import Control.Monad
thyme.cabal view
@@ -1,5 +1,5 @@ name:           thyme-version:        0.3.1.1+version:        0.3.2.0 synopsis:       A faster time library description:     Thyme is a rewrite of the fine @time@ library, with a particular focus@@ -33,6 +33,11 @@     default: False     manual: True +flag lens+    description: use the full lens package+    default: False+    manual: True+ flag show-internal     description: instance Show of internal representation     default: False@@ -46,6 +51,8 @@ library     include-dirs: include     hs-source-dirs: src+    if !flag(lens)+        hs-source-dirs: lens     exposed-modules:         Data.Thyme         Data.Thyme.Calendar@@ -67,9 +74,8 @@         Data.Thyme.Calendar.Internal         Data.Thyme.Clock.Internal         Data.Thyme.Format.Internal-        Data.Thyme.LocalTime.Internal-        Data.Thyme.LocalTime.TimeZone-        Data.Thyme.TH+    if !flag(lens)+        other-modules: Control.Lens     build-depends:         QuickCheck >= 2.4,         attoparsec >= 0.10,@@ -78,17 +84,20 @@         bytestring >= 0.9,         containers,         deepseq >= 1.2,-        lens >= 3.9,+        ghc-prim,+        mtl >= 1.1,         old-locale >= 1.0,         random,-        template-haskell >= 2.6,         text >= 0.11,         time >= 1.4,-        transformers,         vector >= 0.9,         vector-space >= 0.8-    if impl(ghc < 7.6.1)-        build-depends: ghc-prim+    if os(windows)+        build-depends: Win32+    if flag(lens)+        build-depends: lens >= 3.9+    else+        build-depends: profunctors >= 3.1.2     ghc-options: -Wall     if flag(bug-for-bug)         cpp-options: -DBUG_FOR_BUG=1@@ -100,19 +109,26 @@ test-suite sanity     type: exitcode-stdio-1.0     hs-source-dirs: tests+    if !flag(lens)+        hs-source-dirs: lens     main-is: sanity.hs     other-modules: Common+    if !flag(lens)+        other-modules: Control.Lens     build-depends:         QuickCheck,         attoparsec,         base,         bytestring,-        lens,         old-locale,         text,         thyme,         time,         vector-space+    if flag(lens)+        build-depends: lens+    else+        build-depends: profunctors, mtl     ghc-options: -Wall  test-suite rewrite@@ -137,26 +153,33 @@     ghc-options: -threaded -rtsopts -with-rtsopts=-N     hs-source-dirs: tests     if flag(HLint)-        build-depends: base, hlint >= 1.8.53+        build-depends: base, hlint >= 1.8.59     else         buildable: False  benchmark bench     type: exitcode-stdio-1.0     hs-source-dirs: tests+    if !flag(lens)+        hs-source-dirs: lens     main-is: bench.hs     other-modules: Common+    if !flag(lens)+        other-modules: Control.Lens     build-depends:         QuickCheck,         base,         criterion,-        lens,+        mtl,         old-locale,         random,         thyme,         time,-        transformers,         vector-space+    if flag(lens)+        build-depends: lens+    else+        build-depends: profunctors     ghc-options: -Wall  -- vim: et sw=4 ts=4 sts=4: