diff --git a/Data/UnixTime.hs b/Data/UnixTime.hs --- a/Data/UnixTime.hs +++ b/Data/UnixTime.hs @@ -8,6 +8,7 @@ , parseUnixTimeGMT , formatUnixTime , formatUnixTimeGMT + -- * Fromat , Format , webDateFormat , mailDateFormat diff --git a/Data/UnixTime/Conv.hs b/Data/UnixTime/Conv.hs --- a/Data/UnixTime/Conv.hs +++ b/Data/UnixTime/Conv.hs @@ -32,21 +32,25 @@ ---------------------------------------------------------------- -{-| Parsing 'ByteString' to 'UnixTime' interpreting as localtime. - Zone in 'Format' (%Z or %z) would be ignored. - This is a wrapper for strptime_l(). --} +-- | +-- Parsing 'ByteString' to 'UnixTime' interpreting as localtime. +-- Zone in 'Format' (%Z or %z) would be ignored. +-- This is a wrapper for strptime_l(). + parseUnixTime :: Format -> ByteString -> UnixTime parseUnixTime fmt str = unsafePerformIO $ useAsCString fmt $ \cfmt -> useAsCString str $ \cstr -> do sec <- c_parse_unix_time cfmt cstr return $ UnixTime sec 0 +-- | +-- Parsing 'ByteString' to 'UnixTime' interpreting as GMT. +-- Zone in 'Format' (%Z or %z) would be ignored. +-- This is a wrapper for strptime_l(). +-- +-- >>> parseUnixTimeGMT webDateFormat "Thu, 01 Jan 1970 00:00:00 GMT" +-- UnixTime {utSeconds = 0, utMicroSeconds = 0} -{-| Parsing 'ByteString' to 'UnixTime' interpreting as GMT. - Zone in 'Format' (%Z or %z) would be ignored. - This is a wrapper for strptime_l(). --} parseUnixTimeGMT :: Format -> ByteString -> UnixTime parseUnixTimeGMT fmt str = unsafePerformIO $ useAsCString fmt $ \cfmt -> @@ -56,9 +60,10 @@ ---------------------------------------------------------------- -{-| Formatting 'UnixTime' to 'ByteString' in local time. - This is a wrapper for strftime_l(). --} +-- | +-- Formatting 'UnixTime' to 'ByteString' in local time. +-- This is a wrapper for strftime_l(). + formatUnixTime :: Format -> UnixTime -> ByteString formatUnixTime fmt (UnixTime sec _) = unsafePerformIO $ useAsCString fmt $ \cfmt -> do @@ -67,9 +72,13 @@ c_format_unix_time cfmt sec ptr (fromIntegral siz) unsafePackMallocCString ptr -{-| Formatting 'UnixTime' to 'ByteString' in GMT. - This is a wrapper for strftime_l(). --} +-- | +-- Formatting 'UnixTime' to 'ByteString' in GMT. +-- This is a wrapper for strftime_l(). +-- +-- >>> formatUnixTimeGMT webDateFormat $ UnixTime 0 0 +-- "Thu, 01 Jan 1970 00:00:00 GMT" + formatUnixTimeGMT :: Format -> UnixTime -> ByteString formatUnixTimeGMT fmt (UnixTime sec _) = unsafePerformIO $ useAsCString fmt $ \cfmt -> do @@ -80,40 +89,48 @@ ---------------------------------------------------------------- -{-| Format for web (RFC 2616). - This should be used with 'formatUnixTimeGMT'. --} +-- | +-- Format for web (RFC 2616). +-- The value is \"%a, %d %b %Y %H:%M:%S GMT\". +-- This should be used with 'formatUnixTimeGMT' and 'parseUnixTimeGMT'. + webDateFormat :: Format webDateFormat = "%a, %d %b %Y %H:%M:%S GMT" -{-| Format for e-mail (RFC 5322). - This should be used with 'formatUnixTime'. --} +-- | +-- Format for e-mail (RFC 5322). +-- The value is \"%a, %d %b %Y %H:%M:%S %z\". +-- This should be used with 'formatUnixTime' and 'parseUnixTime'. + mailDateFormat :: Format mailDateFormat = "%a, %d %b %Y %H:%M:%S %z" ---------------------------------------------------------------- -{-| From 'EpochTime' to 'UnixTime' setting 'utMicroSeconds' to 0. --} +-- | +-- From 'EpochTime' to 'UnixTime' setting 'utMicroSeconds' to 0. + fromEpochTime :: EpochTime -> UnixTime fromEpochTime sec = UnixTime sec 0 -{-| From 'UnixTime' to 'EpochTime' ignoring 'utMicroSeconds'. --} +-- | +-- From 'UnixTime' to 'EpochTime' ignoring 'utMicroSeconds'. + toEpochTime :: UnixTime -> EpochTime toEpochTime (UnixTime sec _) = sec -{-| From 'ClockTime' to 'UnixTime'. --} +-- | +-- From 'ClockTime' to 'UnixTime'. + fromClockTime :: ClockTime -> UnixTime fromClockTime (TOD sec psec) = UnixTime sec' usec' where sec' = fromIntegral sec usec' = fromIntegral $ psec `div` 1000000 -{-| From 'UnixTime' to 'ClockTime'. --} +-- | +-- From 'UnixTime' to 'ClockTime'. + toClockTime :: UnixTime -> ClockTime toClockTime (UnixTime sec usec) = TOD sec' psec' where diff --git a/Data/UnixTime/Diff.hs b/Data/UnixTime/Diff.hs --- a/Data/UnixTime/Diff.hs +++ b/Data/UnixTime/Diff.hs @@ -14,15 +14,16 @@ ---------------------------------------------------------------- calc :: CTime -> Int32 -> UnixDiffTime -calc sec usec = uncurry UnixDiffTime . ajust sec $ usec +calc sec usec = uncurry UnixDiffTime . adjust sec $ usec calc' :: CTime -> Int32 -> UnixDiffTime -calc' sec usec = uncurry UnixDiffTime . slowAjust sec $ usec +calc' sec usec = uncurry UnixDiffTime . slowAdjust sec $ usec calcU :: CTime -> Int32 -> UnixTime -calcU sec usec = uncurry UnixTime . ajust sec $ usec +calcU sec usec = uncurry UnixTime . adjust sec $ usec -- | Arithmetic operations where (1::UnixDiffTime) means 1 second. + instance Num UnixDiffTime where UnixDiffTime s1 u1 + UnixDiffTime s2 u2 = calc (s1+s2) (u1+u2) UnixDiffTime s1 u1 - UnixDiffTime s2 u2 = calc (s1-s2) (u1-u2) @@ -45,19 +46,39 @@ ---------------------------------------------------------------- -- | Calculating difference between two 'UnixTime'. +-- +-- >>> UnixTime 100 2000 `diffUnixTime` UnixTime 98 2100 +-- UnixDiffTime 1 999900 +-- + diffUnixTime :: UnixTime -> UnixTime -> UnixDiffTime diffUnixTime (UnixTime s1 u1) (UnixTime s2 u2) = calc (s1-s2) (u1-u2) -- | Adding difference to 'UnixTime'. +-- +-- >>> UnixTime 100 2000 `addUnixDiffTime` microSecondsToUnixDiffTime (-1003000) +-- UnixTime {utSeconds = 98, utMicroSeconds = 999000} + addUnixDiffTime :: UnixTime -> UnixDiffTime -> UnixTime addUnixDiffTime (UnixTime s1 u1) (UnixDiffTime s2 u2) = calcU (s1+s2) (u1+u2) -- | Creating difference from seconds. +-- +-- >>> secondsToUnixDiffTime 100 +-- UnixDiffTime 100 0 + secondsToUnixDiffTime :: (Integral a) => a -> UnixDiffTime secondsToUnixDiffTime sec = UnixDiffTime (fromIntegral sec) 0 {-# INLINE secondsToUnixDiffTime #-} -- | Creating difference from micro seconds. +-- +-- >>> microSecondsToUnixDiffTime 12345678 +-- UnixDiffTime 12 345678 +-- +-- >>> microSecondsToUnixDiffTime (-12345678) +-- UnixDiffTime (-12) (-345678) + microSecondsToUnixDiffTime :: (Integral a) => a -> UnixDiffTime microSecondsToUnixDiffTime usec = calc (fromIntegral s) (fromIntegral u) where @@ -66,8 +87,8 @@ ---------------------------------------------------------------- -ajust :: CTime -> Int32 -> (CTime, Int32) -ajust sec usec +adjust :: CTime -> Int32 -> (CTime, Int32) +adjust sec usec | sec >= 0 = ajp | otherwise = ajm where @@ -79,13 +100,13 @@ | otherwise = (sec - 1, usec + micro) ajm | usec <= mmicro = (sec - 1, usec + micro) - | usec < 0 = (sec, usec) + | usec <= 0 = (sec, usec) | otherwise = (sec + 1, usec - micro) -slowAjust :: CTime -> Int32 -> (CTime, Int32) -slowAjust sec usec = (sec + fromIntegral s, usec - u) +slowAdjust :: CTime -> Int32 -> (CTime, Int32) +slowAdjust sec usec = (sec + fromIntegral s, usec - u) where - (s,u) = secondMicro u + (s,u) = secondMicro usec secondMicro :: Integral a => a -> (a,a) secondMicro usec = usec `quotRem` 1000000 diff --git a/Data/UnixTime/Sys.hsc b/Data/UnixTime/Sys.hsc --- a/Data/UnixTime/Sys.hsc +++ b/Data/UnixTime/Sys.hsc @@ -20,8 +20,9 @@ foreign import ccall unsafe "gettimeofday" gettimeofday :: Ptr CTimeVal -> Ptr CTimeZone -> IO CInt -{-| Getting 'UnixTime' from OS. --} +-- | +-- Getting 'UnixTime' from OS. + getUnixTime :: IO UnixTime getUnixTime = allocaBytes (#const sizeof(struct timeval)) $ \ p_timeval -> do diff --git a/Data/UnixTime/Types.hs b/Data/UnixTime/Types.hs --- a/Data/UnixTime/Types.hs +++ b/Data/UnixTime/Types.hs @@ -5,7 +5,8 @@ import Data.Int import Foreign.C.Types --- | Data structure for Unix time. +-- | +-- Data structure for Unix time. data UnixTime = UnixTime { -- | Seconds from 1st Jan 1970 utSeconds :: {-# UNPACK #-} !CTime @@ -13,9 +14,19 @@ , utMicroSeconds :: {-# UNPACK #-} !Int32 } deriving (Eq,Ord,Show) --- | Format of the strptime()/strftime() style. +-- | +-- Format of the strptime()/strftime() style. type Format = ByteString --- | Data structure for UnixTime diff. +-- | +-- Data structure for UnixTime diff. +-- +-- >>> (3 :: UnixDiffTime) + 2 +-- UnixDiffTime 5 0 +-- >>> (2 :: UnixDiffTime) - 5 +-- UnixDiffTime (-3) 0 +-- >>> (3 :: UnixDiffTime) * 2 +-- UnixDiffTime 6 0 + data UnixDiffTime = UnixDiffTime {-# UNPACK #-} !CTime {-# UNPACK #-} !Int32 deriving (Eq,Ord,Show) diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/Test.hs b/test/Test.hs deleted file mode 100644 --- a/test/Test.hs +++ /dev/null @@ -1,103 +0,0 @@ -{-# LANGUAGE OverloadedStrings, TemplateHaskell #-} - -module Main where - -import qualified Data.ByteString.Char8 as BS -import Data.UnixTime -import System.Locale -import System.Time hiding (toClockTime) -import Test.Framework.Providers.HUnit -import Test.Framework.TH.Prime -import Test.Hspec.Expectations - ----------------------------------------------------------------- - -main :: IO () -main = $(defaultMainGenerator) - ----------------------------------------------------------------- - -case_formatUnixTime :: Expectation -case_formatUnixTime = res `shouldBe` ans - where - res = formatUnixTime mailDateFormat $ UnixTime 0 0 - ans = "Thu, 01 Jan 1970 09:00:00 +0900" - -case_formatUnixTimeGMT :: Expectation -case_formatUnixTimeGMT = res `shouldBe` ans - where - res = formatUnixTimeGMT webDateFormat $ UnixTime 0 0 - ans = "Thu, 01 Jan 1970 00:00:00 GMT" - -case_parseUnixTime :: Expectation -case_parseUnixTime = res `shouldBe` ans - where - res = parseUnixTime mailDateFormat "Thu, 01 Jan 1970 09:00:00 +0900" - ans = UnixTime 0 0 - -case_parseUnixTime2 :: Expectation -case_parseUnixTime2 = res `shouldBe` ans - where - res = parseUnixTimeGMT webDateFormat "Thu, 01 Jan 1970 00:00:00 GMT" - ans = UnixTime 0 0 - -case_formatParse :: Expectation -case_formatParse = do - ut@(UnixTime sec _) <- getUnixTime - let ut' = parseUnixTime mailDateFormat $ formatUnixTime mailDateFormat ut - ut' `shouldBe` UnixTime sec 0 - ----------------------------------------------------------------- - -case_fromClockTime :: Expectation -case_fromClockTime = do - ct <- getClockTime - let fmt1 = formatUnixTime "%a, %d %b %Y %H:%M:%S" $ fromClockTime ct - cal <- toCalendarTime ct - let fmt2 = BS.pack $ formatCalendarTime defaultTimeLocale "%a, %d %b %Y %H:%M:%S" cal - fmt1 `shouldBe` fmt2 - -case_toClockTime :: Expectation -case_toClockTime = do - ut <- getUnixTime - let fmt1 = formatUnixTime "%a, %d %b %Y %H:%M:%S" ut - ct = toClockTime ut - cal <- toCalendarTime ct - let fmt2 = BS.pack $ formatCalendarTime defaultTimeLocale "%a, %d %b %Y %H:%M:%S" cal - fmt1 `shouldBe` fmt2 - ----------------------------------------------------------------- - -case_diffTime :: Expectation -case_diffTime = do - ut0 <- getUnixTime - ut1 <- getUnixTime - let ut0' = addUnixDiffTime ut1 $ diffUnixTime ut0 ut1 - ut1' = addUnixDiffTime ut0 $ diffUnixTime ut1 ut0 - ut0' `shouldBe` ut0 - ut1' `shouldBe` ut1 - ----------------------------------------------------------------- - -case_diffTimeFromSeconds :: Expectation -case_diffTimeFromSeconds = do - res1 `shouldBe` ans - res2 `shouldBe` ans - res3 `shouldBe` ans - where - base = parseUnixTime mailDateFormat "Tue, 22 Nov 2011 06:49:58 +0900" - ans = parseUnixTime mailDateFormat "Tue, 22 Nov 2011 06:50:02 +0900" - res1 = addUnixDiffTime base 4 - res2 = addUnixDiffTime base (secondsToUnixDiffTime (4 :: Int)) - res3 = addUnixDiffTime base (microSecondsToUnixDiffTime (4000000 :: Int)) - ----------------------------------------------------------------- - -case_diffTimeToSeconds :: Expectation -case_diffTimeToSeconds = res `shouldBe` ans - where - ans :: Rational - ans = -12.345678 - res = realToFrac $ microSecondsToUnixDiffTime (-12345678 :: Int) - ----------------------------------------------------------------- diff --git a/test/UnixTimeSpec.hs b/test/UnixTimeSpec.hs new file mode 100644 --- /dev/null +++ b/test/UnixTimeSpec.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE OverloadedStrings #-} + +module UnixTimeSpec where + +import Control.Applicative +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as BS +import Data.Time +import Data.UnixTime +import System.Locale +import Test.Hspec + +utcTime0 :: UTCTime +utcTime0 = UTCTime { + utctDay = ModifiedJulianDay 40587 + , utctDayTime = secondsToDiffTime 0 + } + +unixTime0 :: UnixTime +unixTime0 = UnixTime 0 0 + +{- timezone cannot be parsed by some strptime_l(). +jst1970 :: ByteString +jst1970 = "Thu, 01 Jan 1970 09:00:00 +0900" +-} + +spec :: Spec +spec = do + describe "formatUnixTime" $ + it "behaves like the model with utcTime0" $ do + ans <- formatMailModel utcTime0 + formatUnixTime mailDateFormat unixTime0 `shouldBe` ans + +{- + describe "parseUnixTime" $ + it "parses jst1970 properly" $ + parseUnixTime mailDateFormat jst1970 `shouldBe` unixTime0 +-} + + describe "parseUnixTimeGMT & formatUnixTimeGMT" $ + it "inverses the result" $ do + ut@(UnixTime sec _) <- getUnixTime + let dt = formatUnixTimeGMT webDateFormat ut + ut' = parseUnixTimeGMT webDateFormat dt + dt' = formatUnixTimeGMT webDateFormat ut' + ut' `shouldBe` UnixTime sec 0 + dt `shouldBe` dt' + + describe "addUnixDiffTime & diffUnixTime" $ + it "invrses the result" $ do + ut0 <- getUnixTime + ut1 <- getUnixTime + let ut0' = addUnixDiffTime ut1 $ diffUnixTime ut0 ut1 + ut1' = addUnixDiffTime ut0 $ diffUnixTime ut1 ut0 + ut0' `shouldBe` ut0 + ut1' `shouldBe` ut1 + +formatMailModel :: UTCTime -> IO BS.ByteString +formatMailModel ut = ans <$> getCurrentTimeZone + where + toZoneTime tz = utcToZonedTime tz ut + fmt = BS.unpack mailDateFormat + ans tz = BS.pack $ formatTime defaultTimeLocale fmt $ toZoneTime tz diff --git a/test/doctests.hs b/test/doctests.hs new file mode 100644 --- /dev/null +++ b/test/doctests.hs @@ -0,0 +1,11 @@ +module Main where + +import Test.DocTest + +main :: IO () +main = doctest [ + "-XOverloadedStrings" + , "-idist/build" + , "dist/build/cbits/conv.o" + , "Data/UnixTime.hs" + ] diff --git a/unix-time.cabal b/unix-time.cabal --- a/unix-time.cabal +++ b/unix-time.cabal @@ -1,5 +1,5 @@ Name: unix-time -Version: 0.1.2 +Version: 0.1.3 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 @@ -25,19 +25,26 @@ , old-time C-Sources: cbits/conv.c +Test-Suite doctests + Type: exitcode-stdio-1.0 + HS-Source-Dirs: test + Ghc-Options: -threaded + Main-Is: doctests.hs + Build-Depends: base + , doctest >= 0.9.3 + Test-Suite spec Type: exitcode-stdio-1.0 Default-Language: Haskell2010 Hs-Source-Dirs: test - Main-Is: Test.hs - GHC-Options: -Wall + Main-Is: Spec.hs + Other-Modules: UnixTimeSpec Build-Depends: base , bytestring - , hspec-expectations + , hspec , old-locale , old-time - , test-framework-hunit - , test-framework-th-prime + , time , unix-time Source-Repository head