thyme 0.1.0.0 → 0.1.1.0
raw patch · 14 files changed
+304/−166 lines, 14 filesdep +old-localedep ~base
Dependencies added: old-locale
Dependency ranges changed: base
Files
- Data/Micro.hs +19/−5
- Data/Thyme.hs +2/−1
- Data/Thyme/Calendar.hs +15/−6
- Data/Thyme/Calendar/Day.hs +0/−54
- Data/Thyme/Calendar/Internal.hs +142/−0
- Data/Thyme/Calendar/MonthDay.hs +1/−1
- Data/Thyme/Calendar/OrdinalDate.hs +33/−40
- Data/Thyme/Calendar/WeekDate.hs +9/−45
- Data/Thyme/Clock/POSIX.hs +4/−3
- Data/Thyme/Clock/Scale.hs +3/−1
- Data/Thyme/Clock/UTC.hs +4/−2
- Data/Thyme/Format/Internal.hs +61/−0
- Data/Thyme/LocalTime.hs +4/−3
- thyme.cabal +7/−5
Data/Micro.hs view
@@ -27,8 +27,10 @@ deriving instance Show Micro #else instance Show Micro where- show (Micro a) = printf "%d.%06u" q r where- (q, r) = divMod a 1000000+ show (Micro a) = case compare a 0 of+ LT -> printf "-%d.%06u" `uncurry` quotRem (negate a) 1000000+ EQ -> "0"+ GT -> printf "%d.%06u" `uncurry` quotRem a 1000000 #endif {-# INLINE toMicro #-}@@ -52,6 +54,10 @@ signum (Micro a) = Micro (signum a * 1000000) fromInteger a = Micro (fromInteger a * 1000000) +instance Real Micro where+ {-# INLINE toRational #-}+ toRational (Micro a) = toInteger a % 1000000+ instance Fractional Micro where {-# INLINE (/) #-} {-# INLINE recip #-}@@ -60,14 +66,22 @@ recip (Micro a) = Micro (quot 1000000 a) fromRational = toMicro --- TODO: instance Real Micro--- TODO: instance RealFrac Micro+instance RealFrac Micro where+ {-# INLINE properFraction #-}+ properFraction a = (fromIntegral q, r) where+ (q, r) = microQuotRem a (Micro 1000000) #endif +{-# INLINE microQuotRem #-} microQuotRem :: Micro -> Micro -> (Int64, Micro) microQuotRem (Micro a) (Micro b) = (n, Micro f) where (n, f) = quotRem a b +-- for when we'd rather not depend on RealFrac+{-# INLINE microTruncate #-}+microTruncate :: Micro -> Int+microTruncate a = fromIntegral . fst . microQuotRem a $ Micro 1000000+ instance AdditiveGroup Micro where {-# INLINE zeroV #-} zeroV = Micro 0@@ -85,7 +99,7 @@ instance HasBasis Micro where type Basis Micro = () {-# INLINE basisValue #-}- basisValue () = 1+ basisValue () = Micro 1000000 {-# INLINE decompose #-} decompose (Micro a) = [((), fromIntegral a % 1000000)] {-# INLINE decompose' #-}
Data/Thyme.hs view
@@ -1,11 +1,12 @@ module Data.Thyme ( module Data.Thyme.Calendar , module Data.Thyme.Clock+ , module Data.Thyme.Format , module Data.Thyme.LocalTime ) where import Data.Thyme.Calendar import Data.Thyme.Clock--- TODO: Data.Thyme.Format+import Data.Thyme.Format import Data.Thyme.LocalTime
Data/Thyme/Calendar.hs view
@@ -1,23 +1,25 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ViewPatterns #-}+ module Data.Thyme.Calendar ( -- * Days Day (..) -- * Gregorian calendar , Year, Month, DayOfMonth , YearMonthDay (..)- , module Data.Thyme.Calendar , isLeapYear- -- * Lenses- , _toModifiedJulianDay- , _ymdYear, _ymdMonth, _ymdDay+ , module Data.Thyme.Calendar ) where import Prelude hiding ((.)) import Control.Applicative import Control.Category import Control.Lens-import Data.Thyme.Calendar.Day import Data.Thyme.Calendar.OrdinalDate import Data.Thyme.Calendar.MonthDay+import Data.Thyme.Calendar.Internal+import Data.Thyme.Format.Internal+import Data.Thyme.TH {-# INLINE gregorian #-} gregorian :: Simple Iso Day YearMonthDay@@ -38,7 +40,10 @@ fromGregorianValid (YearMonthDay y m d) = review ordinalDate . OrdinalDate y <$> monthDayToDayOfYearValid (isLeapYear y) (MonthDay m d) --- TODO: showGregorian+{-# INLINEABLE showGregorian #-}+showGregorian :: Day -> String+showGregorian (view gregorian -> YearMonthDay y m d) =+ shows04 y . (:) '-' . shows02 m . (:) '-' . shows02 d $ "" {-# INLINE gregorianMonthLength #-} gregorianMonthLength :: Year -> Month -> Int@@ -46,4 +51,8 @@ -- TODO: addGregorianMonthsClip addGregorianMonthsRollover -- TODO: addGregorianYearsClip addGregorianYearsRollover++-- * Lenses+thymeLenses ''Day+thymeLenses ''YearMonthDay
− Data/Thyme/Calendar/Day.hs
@@ -1,54 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}---- #hide-module Data.Thyme.Calendar.Day where--import Prelude-import Control.DeepSeq-import Data.AffineSpace-import Data.Data-import Data.Int-import Data.Ix-import Data.Thyme.TH---- | The Modified Julian Day is a standard count of days, with zero being--- the day 1858-11-17.-newtype Day = ModifiedJulianDay- { toModifiedJulianDay :: Int64- } deriving (Eq, Ord, Enum, Ix, Bounded, NFData, Data, Typeable)--thymeLenses ''Day--#if 1 /*SHOW_INTERNAL*/-deriving instance Show Day-#endif--instance AffineSpace Day where- type Diff Day = Int- {-# INLINE (.-.) #-}- ModifiedJulianDay a .-. ModifiedJulianDay b = fromIntegral (a - b)- {-# INLINE (.+^) #-}- ModifiedJulianDay a .+^ d = ModifiedJulianDay (a + fromIntegral d)----------------------------------------------------------------------------type Year = Int-type DayOfYear = Int-type Month = Int-type DayOfMonth = Int--data YearMonthDay = YearMonthDay- { ymdYear :: {-# UNPACK #-}!Year- , ymdMonth :: {-# UNPACK #-}!Month- , ymdDay :: {-# UNPACK #-}!DayOfMonth- } deriving (Eq, Ord, Data, Typeable, Show)--thymeLenses ''YearMonthDay--instance NFData YearMonthDay-
+ Data/Thyme/Calendar/Internal.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}++-- #hide+module Data.Thyme.Calendar.Internal where++import Prelude+import Control.DeepSeq+import Control.Lens+import Data.AffineSpace+import Data.Data+import Data.Int+import Data.Ix++-- | The Modified Julian Day is a standard count of days, with zero being+-- the day 1858-11-17.+newtype Day = ModifiedJulianDay+ { toModifiedJulianDay :: Int64+ } deriving (Eq, Ord, Enum, Ix, Bounded, NFData, Data, Typeable)++#if 1 /*SHOW_INTERNAL*/+deriving instance Show Day+#endif++instance AffineSpace Day where+ type Diff Day = Int+ {-# INLINE (.-.) #-}+ ModifiedJulianDay a .-. ModifiedJulianDay b = fromIntegral (a - b)+ {-# INLINE (.+^) #-}+ ModifiedJulianDay a .+^ d = ModifiedJulianDay (a + fromIntegral d)++------------------------------------------------------------------------++type Year = Int+type Month = Int+type DayOfMonth = Int++data YearMonthDay = YearMonthDay+ { ymdYear :: {-# UNPACK #-}!Year+ , ymdMonth :: {-# UNPACK #-}!Month+ , ymdDay :: {-# UNPACK #-}!DayOfMonth+ } deriving (Eq, Ord, Data, Typeable, Show)++instance NFData YearMonthDay++------------------------------------------------------------------------++-- | Gregorian leap year?+{-# INLINE isLeapYear #-}+isLeapYear :: Year -> Bool+isLeapYear y = mod y 4 == 0 && (mod y 400 == 0 || mod y 100 /= 0)++type DayOfYear = Int+data OrdinalDate = OrdinalDate+ { odYear :: {-# UNPACK #-}!Year+ , odDay :: {-# UNPACK #-}!DayOfYear+ } deriving (Eq, Ord, Data, Typeable, Show)++instance NFData OrdinalDate++{-# INLINE ordinalDate #-}+ordinalDate :: Simple Iso Day OrdinalDate+ordinalDate = iso toOrd fromOrd where++ {-# INLINEABLE toOrd #-}+ toOrd :: Day -> OrdinalDate+ toOrd (ModifiedJulianDay mjd) = OrdinalDate+ (fromIntegral year) (fromIntegral yd) where+ -- pilfered+ a = mjd + 678575+ quadcent = div a 146097+ b = mod a 146097+ cent = min (div b 36524) 3+ c = b - cent * 36524+ quad = div c 1461+ d = mod c 1461+ y = min (div d 365) 3+ yd = d - y * 365 + 1+ year = quadcent * 400 + cent * 100 + quad * 4 + y + 1++ {-# INLINEABLE fromOrd #-}+ fromOrd :: OrdinalDate -> Day+ fromOrd (OrdinalDate year yd) = ModifiedJulianDay mjd where+ -- pilfered+ y = fromIntegral (year - 1)+ mjd = 365 * y + div y 4 - div y 100 + div y 400 - 678576+ + clip 1 (if isLeapYear year then 366 else 365) (fromIntegral yd)+ clip a b = max a . min b++------------------------------------------------------------------------++type Week = Int+type DayOfWeek = Int+data WeekDate = WeekDate+ { wdYear :: {-# UNPACK #-}!Year+ , wdWeek :: {-# UNPACK #-}!Week+ , wdDay :: {-# UNPACK #-}!DayOfWeek+ } deriving (Eq, Ord, Data, Typeable, Show)++instance NFData WeekDate++-- | Accepts 0-based 'DayOfWeek' and 'Week' when 'review'ing.+{-# INLINE weekDate #-}+weekDate :: Simple Iso Day WeekDate+weekDate = iso toWeek fromWeek where++ {-# INLINEABLE toWeek #-}+ toWeek :: Day -> WeekDate+ toWeek day@(ModifiedJulianDay mjd) = WeekDate+ y1 (fromIntegral $ w1 + 1) (fromIntegral $ mod d 7 + 1) where+ -- pilfered and refactored; no idea what foo and bar mean+ OrdinalDate y0 yd = view ordinalDate day+ d = mjd + 2+ foo :: Year -> {-Week-1-}Int64+ foo y = bar $ review ordinalDate (OrdinalDate y 6)+ bar :: Day -> {-Week-1-}Int64+ bar (ModifiedJulianDay k) = div d 7 - div k 7+ w0 = bar $ ModifiedJulianDay (d - fromIntegral yd + 4)+ (y1, w1) = case w0 of+ -1 -> (y0 - 1, foo (y0 - 1))+ 52 | foo (y0 + 1) == 0 -> (y0 + 1, 0)+ _ -> (y0, w0)++ {-# INLINEABLE fromWeek #-}+ fromWeek :: WeekDate -> Day+ fromWeek wd@(WeekDate y _ _) = fromWeekMax wMax wd where+ WeekDate _ wMax _ = toWeek $ review ordinalDate (OrdinalDate y 365)++{-# INLINE fromWeekMax #-}+fromWeekMax :: Week -> WeekDate -> Day+fromWeekMax wMax (WeekDate y w d) = ModifiedJulianDay mjd where+ -- pilfered and refactored+ ModifiedJulianDay k = review ordinalDate (OrdinalDate y 6)+ -- FIXME: Is it okay to clip d to 0 in the case of Sunday-starting+ -- weeks, and clip w to 0 for OrdinalDate.{sun,mon}dayStartWeek?+ mjd = k - mod k 7 - 10 + clip 0 7 (fromIntegral d)+ + fromIntegral (clip 0 wMax w) * 7+ clip a b = max a . min b+
Data/Thyme/Calendar/MonthDay.hs view
@@ -14,7 +14,7 @@ import Control.Monad import Data.Data import qualified Data.Time.Calendar.MonthDay as T-import Data.Thyme.Calendar.Day+import Data.Thyme.Calendar.Internal import Data.Thyme.TH data MonthDay = MonthDay
Data/Thyme/Calendar/OrdinalDate.hs view
@@ -3,7 +3,8 @@ -- | ISO 8601 Ordinal Date format module Data.Thyme.Calendar.OrdinalDate- ( Year, DayOfYear+ ( Year, isLeapYear+ , DayOfYear, OrdinalDate (..), ordinalDate , module Data.Thyme.Calendar.OrdinalDate ) where @@ -11,53 +12,45 @@ import Control.Applicative import Control.Lens import Control.Monad-import Data.Thyme.Calendar.Day+import Data.Thyme.Calendar.Internal import Data.Thyme.TH -data OrdinalDate = OrdinalDate- { odYear :: {-# UNPACK #-}!Year- , odDay :: {-# UNPACK #-}!DayOfYear }--{-# INLINE ordinalDate #-}-ordinalDate :: Simple Iso Day OrdinalDate-ordinalDate = iso toOrd fromOrd where-- {-# INLINEABLE toOrd #-}- toOrd :: Day -> OrdinalDate- toOrd (ModifiedJulianDay mjd) = OrdinalDate- (fromIntegral year) (fromIntegral yd) where- -- pilfered- a = mjd + 678575- quadcent = div a 146097- b = mod a 146097- cent = min (div b 36524) 3- c = b - cent * 36524- quad = div c 1461- d = mod c 1461- y = min (div d 365) 3- yd = d - y * 365 + 1- year = quadcent * 400 + cent * 100 + quad * 4 + y + 1-- {-# INLINEABLE fromOrd #-}- fromOrd :: OrdinalDate -> Day- fromOrd (OrdinalDate year yd) = ModifiedJulianDay mjd where- -- pilfered- y = fromIntegral (year - 1)- mjd = 365 * y + div y 4 - div y 100 + div y 400 - 678576- + clip 1 (if isLeapYear year then 366 else 365) (fromIntegral yd)- clip a b = max a . min b- {-# INLINE fromOrdinalDateValid #-} fromOrdinalDateValid :: OrdinalDate -> Maybe Day fromOrdinalDateValid od@(OrdinalDate y d) = review ordinalDate od <$ guard (1 <= d && d <= if isLeapYear y then 366 else 365) -{-# INLINE isLeapYear #-}-isLeapYear :: Year -> Bool-isLeapYear y = mod y 4 == 0 && (mod y 400 == 0 || mod y 100 /= 0)+-- | Use @'review' 'weekDate'@ to convert back to 'Day'.+{-# INLINE sundayStartWeek #-}+sundayStartWeek :: Day -> WeekDate+sundayStartWeek day@(ModifiedJulianDay mjd) = WeekDate y+ (fromIntegral $ div d 7 - div k 7) (fromIntegral $ mod d 7) where+ OrdinalDate y yd = view ordinalDate day+ d = mjd + 3+ k = d - fromIntegral yd --- TODO: mondayStartWeek fromMondayStartWeek fromMondayStartWeekValid--- TODO: sundayStartWeek fromSundayStartWeek fromSundayStartWeekValid+-- | Accepts 0−6 for 'DayOfWeek', and 0-based 'Week's.+{-# INLINEABLE fromSundayStartWeekValid #-}+fromSundayStartWeekValid :: WeekDate -> Maybe Day+fromSundayStartWeekValid wd@(WeekDate y w d) = fromWeekMax wMax wd+ <$ guard (0 <= d && d <= 6 && 0 <= w && w <= wMax) where+ WeekDate _ wMax _ = view (from ordinalDate . weekDate) (OrdinalDate y 365)++-- | Use @'review' 'weekDate'@ to convert back to 'Day'.+{-# INLINE mondayStartWeek #-}+mondayStartWeek :: Day -> WeekDate+mondayStartWeek day@(ModifiedJulianDay mjd) = WeekDate y+ (fromIntegral $ div d 7 - div k 7) (fromIntegral $ mod d 7 + 1) where+ OrdinalDate y yd = view ordinalDate day+ d = mjd + 2+ k = d - fromIntegral yd++-- | Accepts 1−7 for 'DayOfWeek', and 0-based 'Week's.+{-# INLINEABLE fromMondayStartWeekValid #-}+fromMondayStartWeekValid :: WeekDate -> Maybe Day+fromMondayStartWeekValid wd@(WeekDate y w d) = fromWeekMax wMax wd+ <$ guard (1 <= d && d <= 7 && 0 <= w && w <= wMax) where+ WeekDate _ wMax _ = view (from ordinalDate . weekDate) (OrdinalDate y 365) -- * Lenses thymeLenses ''OrdinalDate
Data/Thyme/Calendar/WeekDate.hs view
@@ -2,62 +2,26 @@ {-# LANGUAGE TemplateHaskell #-} -- | ISO 8601 Week Date format-module Data.Thyme.Calendar.WeekDate where+module Data.Thyme.Calendar.WeekDate+ ( Year, Week, DayOfWeek+ , WeekDate (..), weekDate+ , module Data.Thyme.Calendar.WeekDate+ ) where import Prelude import Control.Applicative import Control.Lens import Control.Monad-import Data.Data-import Data.Int-import Data.Thyme.Calendar.Day import Data.Thyme.Calendar.OrdinalDate+import Data.Thyme.Calendar.Internal import Data.Thyme.TH import Text.Printf -type Week = Int-type DayOfWeek = Int-data WeekDate = WeekDate- { wdYear :: {-# UNPACK #-}!Year- , wdWeek :: {-# UNPACK #-}!Week- , wdDay :: {-# UNPACK #-}!DayOfWeek- } deriving (Eq, Ord, Data, Typeable, Show)--{-# INLINE weekDate #-}-weekDate :: Simple Iso Day WeekDate-weekDate = iso toWeek fromWeek where-- {-# INLINEABLE toWeek #-}- toWeek :: Day -> WeekDate- toWeek day@(ModifiedJulianDay mjd) = WeekDate- y1 (fromIntegral $ w1 + 1) (fromIntegral $ mod d 7 + 1) where- -- pilfered and refactored; no idea what foo and bar mean- OrdinalDate y0 yd = view ordinalDate day- d = mjd + 2- foo :: Year -> Int64- foo y = bar $ review ordinalDate (OrdinalDate y 6)- bar :: Day -> Int64- bar (ModifiedJulianDay k) = div d 7 - div k 7- w0 = bar $ ModifiedJulianDay (d - fromIntegral yd + 4)- (y1, w1) = case w0 of- -1 -> (y0 - 1, foo (y0 - 1))- 52 | foo (y0 + 1) == 0 -> (y0 + 1, 0)- _ -> (y0, w0)-- {-# INLINEABLE fromWeek #-}- fromWeek :: WeekDate -> Day- fromWeek (WeekDate y w wd) = ModifiedJulianDay mjd where- -- pilfered and refactored- ModifiedJulianDay k = review ordinalDate (OrdinalDate y 6)- WeekDate _ wMax _ = toWeek $ review ordinalDate (OrdinalDate y 365)- mjd = k - mod k 7 - 10 + clip 1 7 (fromIntegral wd)- + fromIntegral (clip 1 wMax w) * 7- clip a b = max a . min b-+-- | Rejects 0-based 'DayOfWeek' and 'Week'.+{-# INLINEABLE fromWeekDateValid #-} fromWeekDateValid :: WeekDate -> Maybe Day-fromWeekDateValid wd@(WeekDate y w d) = review weekDate wd+fromWeekDateValid wd@(WeekDate y w d) = fromWeekMax wMax wd <$ guard (1 <= d && d <= 7 && 1 <= w && w <= wMax) where- -- TODO: inline fromWeek so we can share wMax? WeekDate _ wMax _ = view (from ordinalDate . weekDate) (OrdinalDate y 365) {-# INLINEABLE showWeekDate #-}
Data/Thyme/Clock/POSIX.hs view
@@ -7,8 +7,9 @@ import Control.Lens import Data.AdditiveGroup import Data.AffineSpace+import Data.Micro import qualified Data.Time.Clock.POSIX as T-import Data.Thyme.Calendar.Day+import Data.Thyme.Calendar.Internal import Data.Thyme.Clock.Scale import Data.Thyme.Clock.UTC @@ -28,8 +29,8 @@ fromPOSIX (NominalDiffTime d) = review utcTime $ UTCTime unixEpochDay (DiffTime d) --- TODO: reimplement without 'T.getPOSIXTime' to avoid 'realToFrac'?+-- TODO: reimplement without 'T.getPOSIXTime' to avoid 'Integer'? {-# INLINE getPOSIXTime #-} getPOSIXTime :: IO POSIXTime-getPOSIXTime = fmap realToFrac T.getPOSIXTime+getPOSIXTime = fmap (NominalDiffTime . toMicro . toRational) T.getPOSIXTime
Data/Thyme/Clock/Scale.hs view
@@ -37,7 +37,7 @@ instance HasBasis DiffTime where type Basis DiffTime = () {-# INLINE basisValue #-}- basisValue () = 1+ basisValue () = DiffTime (basisValue ()) {-# INLINE decompose #-} decompose (DiffTime a) = decompose a {-# INLINE decompose' #-}@@ -45,7 +45,9 @@ #if INSTANCE_NUM deriving instance Num DiffTime+deriving instance Real DiffTime deriving instance Fractional DiffTime+deriving instance RealFrac DiffTime #endif {-# INLINE microsecondsToDiffTime #-}
Data/Thyme/Clock/UTC.hs view
@@ -19,7 +19,7 @@ import Data.Int import Data.Ix import Data.Micro-import Data.Thyme.Calendar.Day+import Data.Thyme.Calendar.Internal import Data.Thyme.Clock.Scale import Data.VectorSpace @@ -41,7 +41,7 @@ instance HasBasis NominalDiffTime where type Basis NominalDiffTime = () {-# INLINE basisValue #-}- basisValue () = 1+ basisValue () = NominalDiffTime (basisValue ()) {-# INLINE decompose #-} decompose (NominalDiffTime a) = decompose a {-# INLINE decompose' #-}@@ -49,7 +49,9 @@ #if INSTANCE_NUM deriving instance Num NominalDiffTime+deriving instance Real NominalDiffTime deriving instance Fractional NominalDiffTime+deriving instance RealFrac NominalDiffTime #endif {-# INLINE posixDayLength #-}
+ Data/Thyme/Format/Internal.hs view
@@ -0,0 +1,61 @@+module Data.Thyme.Format.Internal where++import Prelude+import Data.Micro++{-# INLINE shows02 #-}+shows02 :: Int -> String -> String+shows02 n = if n < 10 then (:) '0' . shows n else shows n++{-# INLINE show02 #-}+show02 :: Int -> String+show02 n = if n < 10 then '0' : show n else show n++{-# INLINE show_2 #-}+show_2 :: Int -> String+show_2 n = if n < 10 then ' ' : show n else show n++{-# INLINE show03 #-}+show03 :: Int -> String+show03 n = case () of+ _ | n < 10 -> '0' : '0' : show n+ _ | n < 100 -> '0' : show n+ _ -> show n++{-# INLINE shows04 #-}+shows04 :: Int -> String -> String+shows04 n = case () of+ _ | n < 10 -> (:) '0' . (:) '0' . (:) '0' . shows n+ _ | n < 100 -> (:) '0' . (:) '0' . shows n+ _ | n < 1000 -> (:) '0' . shows n+ _ -> shows n++{-# INLINE show04 #-}+show04 :: Int -> String+show04 n = shows04 n ""++{-# INLINE show60 #-}+show60 :: Micro -> String+show60 (Micro u) = case () of+ _ | u < 10 -> '0' : '0' : '0' : '0' : '0' : show u+ _ | u < 100 -> '0' : '0' : '0' : '0' : show u+ _ | u < 1000 -> '0' : '0' : '0' : show u+ _ | u < 10000 -> '0' : '0' : show u+ _ | u < 100000 -> '0' : show u+ _ -> show u++{-# INLINE show6 #-}+show6 :: Micro -> String+show6 (Micro u) = case () of+ _ | u == 0 -> ""+ _ | u < 10 -> '.' : '0' : '0' : '0' : '0' : '0' : shrink u+ _ | u < 100 -> '.' : '0' : '0' : '0' : '0' : shrink u+ _ | u < 1000 -> '.' : '0' : '0' : '0' : shrink u+ _ | u < 10000 -> '.' : '0' : '0' : shrink u+ _ | u < 100000 -> '.' : '0' : shrink u+ _ -> '.' : shrink u+ where+ shrink v = case divMod v 10 of+ (w, 0) -> shrink w+ _ -> show v+
Data/Thyme/LocalTime.hs view
@@ -24,7 +24,7 @@ import Data.Data import Data.Micro import qualified Data.Time as T-import Data.Thyme.Calendar.Day+import Data.Thyme.Calendar.Internal import Data.Thyme.Clock import Data.Thyme.Clock.Scale import Data.Thyme.Clock.UTC@@ -50,8 +50,9 @@ {-# 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 && 0 <= s && s < 61)+makeTimeOfDayValid h m s@(DiffTime u) = TimeOfDay h m s+ <$ guard (0 <= h && h <= 23 && 0 <= m && m <= 59)+ <* guard (Micro 0 <= u && u < Micro 61000000) {-# INLINE timeOfDay #-} timeOfDay :: Simple Iso DiffTime TimeOfDay
thyme.cabal view
@@ -1,5 +1,5 @@ name: thyme-version: 0.1.0.0+version: 0.1.1.0 synopsis: A faster time library description: A faster time library@@ -8,10 +8,10 @@ license-file: LICENSE author: Liyang HU maintainer: thyme@liyang.hu-copyright: © 2013 Liyang HU+copyright: © 2013 Liyang HU, Ashley Yakeley category: Data, System build-type: Simple-cabal-version: >=1.8+cabal-version: >= 1.8 stability: experimental source-repository head@@ -38,15 +38,17 @@ Data.Thyme.LocalTime other-modules: Data.Micro- Data.Thyme.Calendar.Day+ Data.Thyme.Calendar.Internal Data.Thyme.Clock.Scale Data.Thyme.Clock.UTC+ Data.Thyme.Format.Internal Data.Thyme.TH build-depends:- base >= 4.6 && < 5,+ base >= 4.5 && < 5, deepseq >= 1.2, vector-space >= 0.8, lens >= 3.7,+ old-locale >= 1.0, template-haskell >= 2.6, time >= 1.4 ghc-options: -Wall