[commit: packages/time] master: add missing Current file (bcb1ac3)

[git at git.haskell.org]

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

On branch  : master
Link       : http://git.haskell.org/packages/time.git/commitdiff/bcb1ac36593fe40e822f89c8800641bbb1c0c3ae

>---------------------------------------------------------------

commit bcb1ac36593fe40e822f89c8800641bbb1c0c3ae
Author: Ashley Yakeley <ashley at semantic.org>
Date:   Mon Jul 4 16:27:49 2005 -0700

    add missing Current file
    
    darcs-hash:20050704232749-ac6dd-643f88f66a58d3c45c317cac5d85ef31b471fbb0


>---------------------------------------------------------------

bcb1ac36593fe40e822f89c8800641bbb1c0c3ae
 System/Time/Clock/Current.hs | 42 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 42 insertions(+)

diff --git a/System/Time/Clock/Current.hs b/System/Time/Clock/Current.hs
new file mode 100644
index 0000000..66f4809
--- /dev/null
+++ b/System/Time/Clock/Current.hs
@@ -0,0 +1,42 @@
+{-# OPTIONS -ffi -Wall -Werror #-}
+
+-- #hide
+module System.Time.Clock.Current
+(
+	-- * Current time
+	getCurrentTime,
+) where
+
+import System.Time.Clock.UTC
+
+import Foreign
+import Foreign.C
+
+data CTimeval = MkCTimeval CLong CLong
+
+ctimevalToPosixSeconds :: CTimeval -> POSIXTime
+ctimevalToPosixSeconds (MkCTimeval s mus) = (fromIntegral s) + (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 "time.h gettimeofday" gettimeofday :: Ptr CTimeval -> Ptr () -> IO CInt
+
+-- | Get the current UTC time from the system clock.
+getCurrentTime :: IO UTCTime
+getCurrentTime = with (MkCTimeval 0 0) (\ptval -> do
+	result <- gettimeofday ptval nullPtr
+	if (result == 0)
+	 then do
+	 	tval <- peek ptval
+	 	return (posixSecondsToUTCTime (ctimevalToPosixSeconds tval))
+	 else fail ("error in gettimeofday: " ++ (show result))
+	)