1{-# LANGUAGE CApiFFI #-}
2{-# LANGUAGE CPP #-}
3#if __GLASGOW_HASKELL__ >= 709
4{-# LANGUAGE Safe #-}
5#else
6{-# LANGUAGE Trustworthy #-}
7#endif
8-----------------------------------------------------------------------------
9-- |
10-- Module      :  System.Posix.Time
11-- Copyright   :  (c) The University of Glasgow 2002
12-- License     :  BSD-style (see the file libraries/base/LICENSE)
13--
14-- Maintainer  :  libraries@haskell.org
15-- Stability   :  provisional
16-- Portability :  non-portable (requires POSIX)
17--
18-- POSIX Time support
19--
20-----------------------------------------------------------------------------
21
22module System.Posix.Time (
23        epochTime,
24        -- ToDo: lots more from sys/time.h
25        -- how much already supported by System.Time?
26  ) where
27
28import System.Posix.Types
29import Foreign
30import Foreign.C
31
32-- -----------------------------------------------------------------------------
33-- epochTime
34
35-- | @epochTime@ calls @time@ to obtain the number of
36--   seconds that have elapsed since the epoch (Jan 01 00:00:00 GMT 1970).
37epochTime :: IO EpochTime
38epochTime = throwErrnoIfMinus1 "epochTime" (c_time nullPtr)
39
40foreign import capi unsafe "HsUnix.h time"
41  c_time :: Ptr CTime -> IO CTime
42