[commit: packages/time] format-widths, ghc, improve-leapseconds, master, posix-perf, tasty, wip/travis: initial revision, including draft of Clock and outlines of TAI and Calendar (239f07b)
git at git.haskell.org
git at git.haskell.org
Fri Apr 21 16:43:09 UTC 2017
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/239f07b42ef31a05b9b3894dc656620c8699cc9b
>---------------------------------------------------------------
commit 239f07b42ef31a05b9b3894dc656620c8699cc9b
Author: Ashley Yakeley <ashley at semantic.org>
Date: Tue Feb 22 21:19:59 2005 -0800
initial revision, including draft of Clock and outlines of TAI and Calendar
darcs-hash:20050223051959-ac6dd-ea6ff7c56b81deaffc2584a3a196a8e6262805d9
>---------------------------------------------------------------
239f07b42ef31a05b9b3894dc656620c8699cc9b
Makefile | 30 +++++++++++++
System/Time/Calendar.hs | 61 +++++++++++++++++++++++++
System/Time/Clock.hs | 116 ++++++++++++++++++++++++++++++++++++++++++++++++
System/Time/TAI.hs | 33 ++++++++++++++
TestTime.hs | 11 +++++
5 files changed, 251 insertions(+)
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..4a6709f
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,30 @@
+default: TestTime.run
+
+#TestTime: TestTime.o System/Time/Clock.o System/Time/TAI.o System/Time/Calendar.o
+TestTime: TestTime.o System/Time/Clock.o
+ ghc $^ -o $@
+
+
+clean:
+ rm -f TestTime *.o *.hi System/Time/*.o System/Time/*.hi Makefile.bak
+
+
+%.run: %
+ ./$<
+
+%.hi: %.o
+ @:
+
+%.o: %.hs
+ ghc -c $< -o $@
+
+depend: TestTime.hs System/Time/Clock.hs System/Time/TAI.hs System/Time/Calendar.hs
+ ghc -M $^
+# DO NOT DELETE: Beginning of Haskell dependencies
+TestTime.o : TestTime.hs
+TestTime.o : ./System/Time/Clock.hi
+System/Time/Clock.o : System/Time/Clock.hs
+System/Time/TAI.o : System/Time/TAI.hs
+System/Time/TAI.o : System/Time/Clock.hi
+System/Time/Calendar.o : System/Time/Calendar.hs
+# DO NOT DELETE: End of Haskell dependencies
diff --git a/System/Time/Calendar.hs b/System/Time/Calendar.hs
new file mode 100644
index 0000000..944f4fb
--- /dev/null
+++ b/System/Time/Calendar.hs
@@ -0,0 +1,61 @@
+module System.Time.Calendar
+(
+ -- time zones
+ TimeZone,
+
+ -- getting the locale time zone
+
+ -- converting times to Gregorian "calendrical" format
+ TimeOfDay,CalendarDay,CalendarTime
+
+ -- calendrical arithmetic
+ -- e.g. "one month after March 31st"
+
+ -- parsing and showing dates and times
+) where
+
+-- | count of minutes
+newtype TimeZone = MkTimeZone Int deriving (Eq,Ord,Num)
+
+
+data TimeOfDay = TimeOfDay
+{
+ todHour :: Int,
+ todMin :: Int,
+ todSec :: Int,
+ todPicosec :: Integer
+} deriving (Eq,Ord)
+
+instance Show TimeOfDay where
+ show (TimeOfDay h m s ps) =
+
+data CalendarDay = CalendarDay
+{
+ cdYear :: Integer,
+ cdMonth :: Int,
+ cdDay :: Int
+} deriving (Eq,Ord)
+
+data CalendarTime = CalendarTime
+{
+ ctDay :: CalendarDay,
+ ctTime :: TimeOfDay
+} deriving (Eq,Ord)
+
+
+
+-- ((365 * 3 + 366) * 24 + 365 * 4) * 3 + (365 * 3 + 366) * 25
+dayToCalendar :: ModJulianDay -> CalendarDay
+dayToCalendar mjd = let
+ a = mjd + 2000 -- ?
+ quadcent = a / 146097
+ b = a % 146097
+ cent = min (b / 36524) 3
+ ...to be continued
+
+
+utcToCalendar :: TimeZone -> UTCTime -> CalendarTime
+
+calendarToUTC :: TimeZone -> CalendarTime -> UTCTime
+
+
diff --git a/System/Time/Clock.hs b/System/Time/Clock.hs
new file mode 100644
index 0000000..386c920
--- /dev/null
+++ b/System/Time/Clock.hs
@@ -0,0 +1,116 @@
+{-# OPTIONS -ffi #-}
+
+module System.Time.Clock
+(
+ -- Modified Julian days and dates (for UT1)
+ ModJulianDay,ModJulianDate,
+
+ -- absolute time intervals
+ DiffTime,timeToSISeconds,siSecondsToTime,
+
+ -- UTC arithmetic
+ UTCTime(..),UTCDiffTime,utcTimeToUTCSeconds,utcSecondsToUTCTime,
+
+ -- getting the current UTC time
+ getCurrentTime
+) where
+
+import Foreign
+import Foreign.C
+
+-- | standard Julian count of Earth days
+type ModJulianDay = Integer
+
+-- | standard Julian dates for UT1, 1 = 1 day
+type ModJulianDate = Rational
+
+secondPicoseconds :: (Num a) => a
+secondPicoseconds = 1000000000000
+
+newtype DiffTime = MkDiffTime Integer deriving (Eq,Ord,Show)
+
+timeToSIPicoseconds :: DiffTime -> Integer
+timeToSIPicoseconds (MkDiffTime ps) = ps
+
+siPicosecondsToTime :: Integer -> DiffTime
+siPicosecondsToTime = MkDiffTime
+
+timeToSISeconds :: (Fractional a) => DiffTime -> a
+timeToSISeconds t = fromRational ((toRational (timeToSIPicoseconds t)) / (toRational secondPicoseconds));
+
+siSecondsToTime :: (Real a) => a -> DiffTime
+siSecondsToTime t = siPicosecondsToTime (round ((toRational t) * secondPicoseconds))
+
+data UTCTime = UTCTime {
+ utctDay :: ModJulianDay,
+ utctDayTime :: DiffTime
+}
+
+newtype UTCDiffTime = MkUTCDiffTime Integer
+
+utcTimeToUTCPicoseconds :: UTCDiffTime -> Integer
+utcTimeToUTCPicoseconds (MkUTCDiffTime ps) = ps
+
+utcPicosecondsToUTCTime :: Integer -> UTCDiffTime
+utcPicosecondsToUTCTime = MkUTCDiffTime
+
+utcTimeToUTCSeconds :: (Fractional a) => UTCDiffTime -> a
+utcTimeToUTCSeconds t = fromRational ((toRational (utcTimeToUTCPicoseconds t)) / (toRational secondPicoseconds))
+
+utcSecondsToUTCTime :: (Real a) => a -> UTCDiffTime
+utcSecondsToUTCTime t = utcPicosecondsToUTCTime (round ((toRational t) * secondPicoseconds))
+
+posixDaySeconds :: (Num a) => a
+posixDaySeconds = 86400
+
+posixDayPicoseconds :: Integer
+posixDayPicoseconds = posixDaySeconds * secondPicoseconds
+
+unixEpochMJD :: ModJulianDay
+unixEpochMJD = 40587
+
+posixPicosecondsToUTCTime :: Integer -> UTCTime
+posixPicosecondsToUTCTime i = let
+ (d,t) = divMod i posixDayPicoseconds
+ in UTCTime (d + unixEpochMJD) (siPicosecondsToTime t)
+
+utcTimeToPOSIXPicoseconds :: UTCTime -> Integer
+utcTimeToPOSIXPicoseconds (UTCTime d t) =
+ ((d - unixEpochMJD) * posixDayPicoseconds) + min posixDayPicoseconds (timeToSIPicoseconds t)
+
+addUTCTime :: UTCDiffTime -> UTCTime -> UTCTime
+addUTCTime x t = posixPicosecondsToUTCTime ((utcTimeToUTCPicoseconds x) + (utcTimeToPOSIXPicoseconds t))
+
+diffUTCTime :: UTCTime -> UTCTime -> UTCDiffTime
+diffUTCTime a b = utcPicosecondsToUTCTime ((utcTimeToPOSIXPicoseconds a) - (utcTimeToPOSIXPicoseconds b))
+
+
+-- Get current time
+
+data CTimeval = MkCTimeval CLong CLong
+
+ctimevalToPosixPicoseconds :: CTimeval -> Integer
+ctimevalToPosixPicoseconds (MkCTimeval s mus) = ((fromIntegral s) * 1000000 + (fromIntegral mus)) * 1000000
+
+instance Storable CTimeval where
+ sizeOf _ = (sizeOf (undefined :: CLong)) * 2
+ alignment _ = alignment (undefined :: CLong)
+ peek p = do
+ s <- peekElemOff (castPtr p) 0
+ mus <- peekElemOff (castPtr p) 1
+ return (MkCTimeval s mus)
+ poke p (MkCTimeval s mus) = do
+ pokeElemOff (castPtr p) 0 s
+ pokeElemOff (castPtr p) 1 mus
+
+foreign import ccall unsafe "sys/time.h gettimeofday" gettimeofday :: Ptr CTimeval -> Ptr () -> IO CInt
+
+getCurrentTime :: IO UTCTime
+getCurrentTime = with (MkCTimeval 0 0) (\ptval -> do
+ result <- gettimeofday ptval nullPtr
+ if (result == 0)
+ then do
+ tval <- peek ptval
+ return (posixPicosecondsToUTCTime (ctimevalToPosixPicoseconds tval))
+ else fail ("error in gettimeofday: " ++ (show result))
+ )
diff --git a/System/Time/TAI.hs b/System/Time/TAI.hs
new file mode 100644
index 0000000..fb5df5a
--- /dev/null
+++ b/System/Time/TAI.hs
@@ -0,0 +1,33 @@
+-- | most people won't need this module
+module System.Time.TAI
+(
+ -- TAI arithmetic
+ AbsoluteTime,addAbsoluteTime,diffAbsoluteTime,
+
+ -- leap-second table type
+ LeapSecondTable,
+
+ -- conversion between UTC and TAI with table
+ utcDayLength,utcToTAITime,taiToUTCTime
+) where
+
+import System.Time.Clock
+
+-- | TAI
+type AbsoluteTime = MkAbsoluteTime Integer
+
+addAbsoluteTime :: DiffTime -> AbsoluteTime -> AbsoluteTime
+
+diffAbsoluteTime :: AbsoluteTime -> AbsoluteTime -> DiffTime
+
+-- | TAI - UTC during this day
+type LeapSecondTable = ModJulianDay -> Int
+
+utcDayLength :: LeapSecondTable -> ModJulianDay -> DiffTime
+utcDayLength table day = siSecondsToTime (86400 + (table (day + 1)) - (table day))
+
+utcToTAITime :: LeapSecondTable -> UTCTime -> TAITime
+utcToTAITime table (UTCTime day dtime) = siSecondsToTime (table day) +
+
+taiToUTCTime :: LeapSecondTable -> TAITime -> UTCTime
+
diff --git a/TestTime.hs b/TestTime.hs
new file mode 100644
index 0000000..77dff58
--- /dev/null
+++ b/TestTime.hs
@@ -0,0 +1,11 @@
+module Main where
+
+import System.Time.Clock
+--import System.Time.TAI
+--import System.Time.Calendar
+
+main :: IO ()
+main = do
+ now <- getCurrentTime
+ putStrLn (show (utctDay now) ++ "," ++ show (utctDayTime now))
+-- putStrLn (show (utcToCalendar (60 * -8) now))
More information about the ghc-commits
mailing list