[commit: packages/time] master: Changed %S to return whole seconds, and added %Q and %q. (f73da90)
git at git.haskell.org
git at git.haskell.org
Fri Jan 23 22:57:44 UTC 2015
Repository : ssh://git@git.haskell.org/time
On branch : master
Link : http://git.haskell.org/packages/time.git/commitdiff/f73da902c82a2ce5f0a336ee1fd1774df5bdb6e2
>---------------------------------------------------------------
commit f73da902c82a2ce5f0a336ee1fd1774df5bdb6e2
Author: bjorn <bjorn at bringert.net>
Date: Sun Feb 11 07:53:58 2007 -0800
Changed %S to return whole seconds, and added %Q and %q.
Implements part of http://hackage.haskell.org/trac/ghc/ticket/1007
formatTime: Change %S to: the number of whole seconds.
formatTime: Add %q: the number of picoseconds (including trailing zeroes).
formatTime: Add %Q: decimal point and second decimals, without trailing zeros.
If the number of picoseconds is zero, nothing is produced (not even the decimal point).
Rationale: Currently %S includes decimals if there are any. This is different from
strftime, and there is no format specifier for just the integer part of the seconds.
It would be nice to have such a specifier to implement many standard date formats
(e.g. RFC 822). Also a specifier for second decimals would also help when using %s.
Currently there is no reasonable way to get more than integer second precision with
since-epoch timestamps. The current %S would be equivalent to %S%Q under this proposal."
darcs-hash:20070211155358-6cdb2-de94204665c57a1b86b65bd80f1a98d3d469d0f0
>---------------------------------------------------------------
f73da902c82a2ce5f0a336ee1fd1774df5bdb6e2
Data/Time/LocalTime/Format.hs | 19 +++++++++++++++----
Data/Time/LocalTime/Parse.hs | 34 +++++++++++++++++++---------------
2 files changed, 34 insertions(+), 19 deletions(-)
diff --git a/Data/Time/LocalTime/Format.hs b/Data/Time/LocalTime/Format.hs
index c13160e..fc26327 100644
--- a/Data/Time/LocalTime/Format.hs
+++ b/Data/Time/LocalTime/Format.hs
@@ -20,6 +20,7 @@ import Data.Time.Clock.POSIX
import System.Locale
import Data.Maybe
import Data.Char
+import Data.Fixed
-- <http://www.opengroup.org/onlinepubs/007908799/xsh/strftime.html>
class FormatTime t where
@@ -69,11 +70,19 @@ class FormatTime t where
--
-- [@%M@] minute, @00@ - @59@
--
--- [@%S@] second with decimal part if not an integer, @00@ - @60.999999999999@
+-- [@%S@] second, without decimal part, @00@ - @60@
+--
+-- [@%q@] picosecond, including trailing zeros, @000000000000@ - @999999999999 at .
+--
+-- [@%Q@] decimal point and up to 12 second decimals, without trailing zeros.
+-- For a whole number of seconds, @%Q@ produces the empty string.
--
-- For UTCTime and ZonedTime:
--
--- [@%s@] number of seconds since the Unix epoch
+-- [@%s@] number of whole seconds since the Unix epoch. For times before
+-- the Unix epoch, this is a negative number. Note that in @%s.%q@ and @%s%Q@
+-- the decimals are positive, not negative. For example, 0.9 seconds
+-- before the Unix epoch is formatted as @-1.1@ with @%s%Q at .
--
-- For Day (and LocalTime and ZonedTime and UTCTime):
--
@@ -154,14 +163,16 @@ instance FormatTime TimeOfDay where
-- Minute
formatCharacter 'M' = Just (\_ -> show2 . todMin)
-- Second
- formatCharacter 'S' = Just (\_ -> show2Fixed . todSec)
+ formatCharacter 'S' = Just (\_ -> (show2 :: Int -> String) . truncate . todSec)
+ formatCharacter 'q' = Just (\_ -> drop 1 . dropWhile (/='.') . showFixed False . todSec)
+ formatCharacter 'Q' = Just (\_ -> dropWhile (/='.') . showFixed True . todSec)
-- Default
formatCharacter _ = Nothing
instance FormatTime ZonedTime where
formatCharacter 'c' = Just (\locale -> formatTime locale (dateTimeFmt locale))
- formatCharacter 's' = Just (\_ zt -> show (truncate (utcTimeToPOSIXSeconds (zonedTimeToUTC zt)) :: Integer))
+ formatCharacter 's' = Just (\_ zt -> show (floor (utcTimeToPOSIXSeconds (zonedTimeToUTC zt)) :: Integer))
formatCharacter c = case (formatCharacter c) of
Just f -> Just (\locale dt -> f locale (zonedTimeToLocalTime dt))
Nothing -> case (formatCharacter c) of
diff --git a/Data/Time/LocalTime/Parse.hs b/Data/Time/LocalTime/Parse.hs
index a5420d3..b6ae350 100644
--- a/Data/Time/LocalTime/Parse.hs
+++ b/Data/Time/LocalTime/Parse.hs
@@ -123,10 +123,9 @@ parseValue l c =
'k' -> spdigits 2
'l' -> spdigits 2
'M' -> digits 2
- 'S' -> do s <- digits 2
- ds <- liftM2 (:) (char '.') (munch isDigit)
- <++ return ""
- return $ s ++ ds
+ 'S' -> digits 2
+ 'q' -> digits 12
+ 'Q' -> liftM2 (:) (char '.') (munch isDigit) <++ return ""
's' -> (char '-' >> liftM ('-':) (munch1 isDigit))
<++ munch1 isDigit
'Y' -> digits 4
@@ -246,18 +245,20 @@ instance ParseTime TimeOfDay where
'k' -> TimeOfDay (read x) m s
'l' -> TimeOfDay (read x) m s
'M' -> TimeOfDay h (read x) s
- 'S' -> TimeOfDay h m (readFixed x)
+ 'S' -> TimeOfDay h m (fromInteger (read x))
+ 'q' -> TimeOfDay h m (mkPico (truncate s) (read x))
+ 'Q' -> if null x then t
+ else let ps = read $ take 12 $ rpad 12 '0' $ drop 1 x
+ in TimeOfDay h m (mkPico (truncate s) ps)
_ -> t
where am = TimeOfDay (h `mod` 12) m s
pm = TimeOfDay (if h < 12 then h + 12 else h) m s
+rpad :: Int -> a -> [a] -> [a]
+rpad n c xs = xs ++ replicate (n - length xs) c
-readFixed :: HasResolution a => String -> Fixed a
-readFixed s = case break (=='.') s of
- (x,"") -> fromInteger (read x)
- (x,_:y) -> mkFixed12 (read x) (read (rpad 12 '0' y))
- where rpad n c xs = xs ++ replicate (n - length xs) c
- mkFixed12 i f = fromInteger i + fromRational (f % 1000000000000)
+mkPico :: Integer -> Integer -> Pico
+mkPico i f = fromInteger i + fromRational (f % 1000000000000)
instance ParseTime LocalTime where
buildTime l xs = LocalTime (buildTime l xs) (buildTime l xs)
@@ -278,9 +279,12 @@ instance ParseTime TimeZone where
instance ParseTime ZonedTime where
buildTime l xs = foldl f (ZonedTime (buildTime l xs) (buildTime l xs)) xs
where
- f t (c,x) =
+ f t@(ZonedTime (LocalTime _ tod) z) (c,x) =
case c of
- 's' -> utcToZonedTime (zonedTimeZone t) (posixSecondsToUTCTime (fromInteger (read x)))
+ 's' -> let s = fromInteger (read x)
+ (_,ps) = properFraction (todSec tod) :: (Integer,Pico)
+ s' = s + fromRational (toRational ps)
+ in utcToZonedTime z (posixSecondsToUTCTime s')
_ -> t
instance ParseTime UTCTime where
@@ -292,10 +296,10 @@ instance Read Day where
readsPrec _ = readParen False $ readsTime defaultTimeLocale "%Y-%m-%d"
instance Read TimeOfDay where
- readsPrec _ = readParen False $ readsTime defaultTimeLocale "%H:%M:%S"
+ readsPrec _ = readParen False $ readsTime defaultTimeLocale "%H:%M:%S%Q"
instance Read LocalTime where
- readsPrec _ = readParen False $ readsTime defaultTimeLocale "%Y-%m-%d %H:%M:%S"
+ readsPrec _ = readParen False $ readsTime defaultTimeLocale "%Y-%m-%d %H:%M:%S%Q"
instance Read TimeZone where
readsPrec _ = readParen False $ \s ->
More information about the ghc-commits
mailing list