[commit: packages/time] format-widths, ghc, improve-leapseconds, master, posix-perf, tasty, wip/travis: Changed %S to return whole seconds, and added %Q and %q. (f73da90)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/time

On branches: format-widths,ghc,improve-leapseconds,master,posix-perf,tasty,wip/travis
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 ->