unix-time 0.1.2 → 0.1.3
raw patch · 10 files changed
+181/−151 lines, 10 filesdep +doctestdep +hspecdep +timedep −hspec-expectationsdep −test-framework-hunitdep −test-framework-th-primedep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: doctest, hspec, time
Dependencies removed: hspec-expectations, test-framework-hunit, test-framework-th-prime
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- Data/UnixTime.hs +1/−0
- Data/UnixTime/Conv.hs +45/−28
- Data/UnixTime/Diff.hs +30/−9
- Data/UnixTime/Sys.hsc +3/−2
- Data/UnixTime/Types.hs +14/−3
- test/Spec.hs +1/−0
- test/Test.hs +0/−103
- test/UnixTimeSpec.hs +63/−0
- test/doctests.hs +11/−0
- unix-time.cabal +13/−6
Data/UnixTime.hs view
@@ -8,6 +8,7 @@ , parseUnixTimeGMT , formatUnixTime , formatUnixTimeGMT+ -- * Fromat , Format , webDateFormat , mailDateFormat
Data/UnixTime/Conv.hs view
@@ -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
Data/UnixTime/Diff.hs view
@@ -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
Data/UnixTime/Sys.hsc view
@@ -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
Data/UnixTime/Types.hs view
@@ -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)
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
− test/Test.hs
@@ -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)------------------------------------------------------------------
+ test/UnixTimeSpec.hs view
@@ -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
+ test/doctests.hs view
@@ -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"+ ]
unix-time.cabal view
@@ -1,5 +1,5 @@ Name: unix-time-Version: 0.1.2+Version: 0.1.3 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> 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