datetime 0.2.1 → 0.3.0
raw patch · 5 files changed
+235/−170 lines, 5 filesdep +HUnitdep +datetimedep +test-frameworkdep ~QuickCheckdep ~basenew-uploaderPVP ok
version bump matches the API change (PVP)
Dependencies added: HUnit, datetime, test-framework, test-framework-hunit, test-framework-quickcheck2
Dependency ranges changed: QuickCheck, base
API changes (from Hackage documentation)
- Data.DateTime: instance Arbitrary UTCTime
+ Data.DateTime: sqlFormat :: String
Files
- datetime.cabal +34/−6
- src/Data/DateTime.hs +142/−0
- src/Data/DateTime.lhs +0/−164
- test/Data/DateTimeTest.hs +51/−0
- test/Suite.hs +8/−0
datetime.cabal view
@@ -1,5 +1,5 @@ name: datetime-version: 0.2.1+version: 0.3.0 stability: experimental Description: Provides several utilities for easily converting among the@@ -8,18 +8,46 @@ license: GPL license-file: COPYING author: Eric Sessoms <nubgames@gmail.com>-maintainer: nubgames@gmail.com-homepage: http://github.com/esessoms/datetime+maintainer: hackage@stackbuilders.com+homepage: http://github.com/stackbuilders/datetime category: Data-synopsis: Utilities to make Data.Time.* easier to use.-cabal-version: >= 1.2+synopsis: Utilities to make Data.Time.* easier to use (deprecated)+cabal-version: >= 1.10 build-type: Simple +source-repository head+ type: git+ location: https://github.com/stackbuilders/datetime.git+ library build-depends: base < 5,- QuickCheck >= 2 && < 3, old-locale >= 1.0.0.1, old-time >= 1.0.0.1, time >= 1.1.2.2+ default-extensions: CPP exposed-modules: Data.DateTime hs-source-dirs: src+ ghc-options: -Wall+ default-language: Haskell2010++test-suite test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Suite.hs+ other-modules: Data.DateTimeTest+ build-depends:+ datetime++ , old-locale >= 1.0.0.1+ , old-time >= 1.0.0.1+ , time >= 1.1.2.2++ , base >=4.2 && <4.9+ , test-framework+ , HUnit+ , QuickCheck+ , test-framework-hunit+ , test-framework-quickcheck2++ ghc-options: -Wall+ default-language: Haskell2010
+ src/Data/DateTime.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE CPP #-}++module Data.DateTime where++import Data.Fixed (div')+import Data.Function (on)++import Data.Time.Clock hiding (getCurrentTime)+import Data.Time.Format+import Data.Time.LocalTime+import Numeric (fromRat)++#if !MIN_VERSION_time(1,5,0)+import System.Locale+#endif++import System.Time hiding (toClockTime)++import qualified Data.Time.Calendar as Calendar+import qualified Data.Time.Clock as Clock++-- Define a local synonym for UTCTime just to get some insulation from+-- the craziness of the Haskell standard library date and time functions.++type DateTime = UTCTime++-- Defined here so that users don't need to know about Data.Time.Clock.++getCurrentTime :: IO DateTime+getCurrentTime = Clock.getCurrentTime++-- Conversion back and forth between DateTime and MJD.++toMJD :: DateTime -> Rational+toMJD = getModJulianDate . toUniversalTime++toMJD' :: RealFloat a => DateTime -> a+toMJD' = fromRat . toMJD++fromMJD :: Rational -> DateTime+fromMJD = fromUniversalTime . ModJulianDate++fromMJD' :: RealFloat a => a -> DateTime+fromMJD' = fromMJD . realToFrac++-- Because UTCTime is opaque, we need to convert to UniversalTime in+-- order to do anything with it, but these functions are mainly of+-- interest internally.++toUniversalTime :: DateTime -> UniversalTime+toUniversalTime = localTimeToUT1 0 . utcToLocalTime utc++fromUniversalTime :: UniversalTime -> DateTime+fromUniversalTime = localTimeToUTC utc . ut1ToLocalTime 0++-- Take apart a DateTime into pieces and parts.++toGregorian' :: DateTime -> (Integer, Int, Int)+toGregorian' dt = (y, m, d)+ where+ (y, m, d, _, _, _) = toGregorian dt++toGregorian :: DateTime -> (Integer, Int, Int, Int, Int, Int)+toGregorian dt = (year, month, day', hours, minutes, seconds `div'` 1)+ where+ LocalTime day tod = utcToLocalTime utc dt+ (year, month, day') = Calendar.toGregorian day+ TimeOfDay hours minutes seconds = tod++-- Combine pieces and parts to produce a DateTime.++fromGregorian' :: Integer -> Int -> Int -> DateTime+fromGregorian' y m d = fromGregorian y m d 0 0 0++fromGregorian :: Integer -> Int -> Int -> Int -> Int -> Int -> DateTime+fromGregorian year month day hours minutes seconds =+ UTCTime day' (secondsToDiffTime . fromIntegral $ seconds')+ where+ day' = Calendar.fromGregorian year month day+ seconds' = 3600 * hours + 60 * minutes + seconds++-- Getting closer to the machine: Not all the functionality of+-- System.Time is available in Data.Time, and the only way we can convert+-- back and forth is to go through seconds.++toSeconds :: DateTime -> Integer+toSeconds dt = floor $+ (86400.0 :: Double) * fromRational (toMJD dt - startOfTimeMJD)++fromSeconds :: Integer -> DateTime+fromSeconds s = fromMJD $+ fromIntegral s / 86400 + startOfTimeMJD++toClockTime :: DateTime -> ClockTime+toClockTime dt = TOD (toSeconds dt) 0++fromClockTime :: ClockTime -> DateTime+fromClockTime (TOD s _) = fromSeconds s++startOfTime :: DateTime+startOfTime = fromGregorian' 1970 1 1++startOfTimeMJD :: Rational+startOfTimeMJD = toMJD startOfTime++-- Formatting and parsing, with special attention to the format used by+-- ODBC and MySQL.++toSqlString :: DateTime -> String+toSqlString = formatDateTime sqlFormat++fromSqlString :: String -> Maybe DateTime+fromSqlString = parseDateTime sqlFormat++formatDateTime :: String -> DateTime -> String+formatDateTime = formatTime defaultTimeLocale++parseDateTime :: String -> String -> Maybe DateTime+parseDateTime = parseTime defaultTimeLocale++sqlFormat :: String+sqlFormat = iso8601DateFormat (Just "%T")++-- Simple arithmetic.++addMinutes' :: Int -> DateTime -> DateTime+addMinutes' = addMinutes . fromIntegral++addMinutes :: Integer -> DateTime -> DateTime+addMinutes m = addSeconds (60 * m)++diffMinutes' :: DateTime -> DateTime -> Int+diffMinutes' x = fromIntegral . diffMinutes x++diffMinutes :: DateTime -> DateTime -> Integer+diffMinutes x = (`div` 60) . diffSeconds x++addSeconds :: Integer -> DateTime -> DateTime+addSeconds s dt = fromSeconds $ toSeconds dt + s++diffSeconds :: DateTime -> DateTime -> Integer+diffSeconds = (-) `on` toSeconds
− src/Data/DateTime.lhs
@@ -1,164 +0,0 @@-> module Data.DateTime where--> import Data.Fixed (div')-> import Data.Function (on)-> import Data.Maybe (fromJust)-> import Data.Time.Calendar hiding (fromGregorian, toGregorian)-> import Data.Time.Clock hiding (getCurrentTime)-> import Data.Time.Format-> import Data.Time.LocalTime-> -- import Database.HDBC-> import Numeric (fromRat)-> import System.Locale-> import System.Time hiding (toClockTime)-> import Test.QuickCheck--> import qualified Data.Time.Calendar as Calendar-> import qualified Data.Time.Clock as Clock--Define a local synonym for UTCTime just to get some insulation from-the craziness of the Haskell standard library date and time functions.--> type DateTime = UTCTime--> instance Arbitrary UTCTime where-> arbitrary = do-> offset <- choose (0, 20000) :: Gen Float-> return . fromMJD' $ offset + fromRational startOfTimeMJD--So that we can use our DateTime class with HDBC.--> -- instance SqlType UTCTime where-> -- toSql = toSql . toClockTime-> -- fromSql = fromClockTime . fromSql--Defined here so that users don't need to know about Data.Time.Clock.--> getCurrentTime :: IO DateTime-> getCurrentTime = Clock.getCurrentTime--Conversion back and forth between DateTime and MJD.--> toMJD :: DateTime -> Rational-> toMJD = getModJulianDate . toUniversalTime--> toMJD' :: RealFloat a => DateTime -> a-> toMJD' = fromRat . toMJD--> fromMJD :: Rational -> DateTime-> fromMJD = fromUniversalTime . ModJulianDate--> fromMJD' :: RealFloat a => a -> DateTime-> fromMJD' = fromMJD . realToFrac--> invariant f x = f x == x- -> prop_MJD = invariant $ fromMJD . toMJD-> prop_MJD' = invariant $ fromMJD' . toMJD'--Because UTCTime is opaque, we need to convert to UniversalTime in-order to do anything with it, but these functions are mainly of-interest internally.--> toUniversalTime :: DateTime -> UniversalTime-> toUniversalTime = localTimeToUT1 0 . utcToLocalTime utc--> fromUniversalTime :: UniversalTime -> DateTime-> fromUniversalTime = localTimeToUTC utc . ut1ToLocalTime 0--> prop_Universal = invariant $ fromUniversalTime . toUniversalTime--Take apart a DateTime into pieces and parts.- -> toGregorian' :: DateTime -> (Integer, Int, Int)-> toGregorian' dt = (y, m, d)-> where-> (y, m, d, _, _, _) = toGregorian dt--> toGregorian :: DateTime -> (Integer, Int, Int, Int, Int, Int)-> toGregorian dt = (year, month, day', hours, minutes, seconds `div'` 1)-> where-> LocalTime day tod = utcToLocalTime utc dt-> (year, month, day') = Calendar.toGregorian day-> TimeOfDay hours minutes seconds = tod--Combine pieces and parts to produce a DateTime.- -> fromGregorian' :: Integer -> Int -> Int -> DateTime-> fromGregorian' y m d = fromGregorian y m d 0 0 0--> fromGregorian :: Integer -> Int -> Int -> Int -> Int -> Int -> DateTime-> fromGregorian year month day hours minutes seconds =-> UTCTime day' (secondsToDiffTime . fromIntegral $ seconds')-> where-> day' = Calendar.fromGregorian year month day-> seconds' = 3600 * hours + 60 * minutes + seconds--Getting closer to the machine: Not all the functionality of-System.Time is available in Data.Time, and the only way we can convert-back and forth is to go through seconds.--> toSeconds :: DateTime -> Integer-> toSeconds dt = floor $-> 86400.0 * fromRational (toMJD dt - startOfTimeMJD)--> fromSeconds :: Integer -> DateTime-> fromSeconds s = fromMJD $-> fromIntegral s / 86400 + startOfTimeMJD--> toClockTime :: DateTime -> ClockTime-> toClockTime dt = TOD (toSeconds dt) 0--> fromClockTime :: ClockTime -> DateTime-> fromClockTime (TOD s _) = fromSeconds s--> startOfTime :: DateTime-> startOfTime = fromGregorian' 1970 1 1--> prop_StartOfTime _ = toSeconds startOfTime == 0--> startOfTimeMJD :: Rational-> startOfTimeMJD = toMJD startOfTime--Formatting and parsing, with special attention to the format used by-ODBC and MySQL.--> toSqlString :: DateTime -> String-> toSqlString = formatDateTime sqlFormat--> fromSqlString :: String -> Maybe DateTime-> fromSqlString = parseDateTime sqlFormat--> prop_SqlString dt = (fromJust . fromSqlString . toSqlString $ dt') == dt'-> where-> Just dt' = fromSqlString . toSqlString $ dt--> prop_SqlStartOfTime _ = toSqlString startOfTime == "1970-01-01 00:00:00"--> formatDateTime :: String -> DateTime -> String-> formatDateTime = formatTime defaultTimeLocale--> parseDateTime :: String -> String -> Maybe DateTime-> parseDateTime = parseTime defaultTimeLocale--> sqlFormat = iso8601DateFormat (Just "%T")--Simple arithmetic.--> addMinutes' :: Int -> DateTime -> DateTime-> addMinutes' = addMinutes . fromIntegral- -> addMinutes :: Integer -> DateTime -> DateTime-> addMinutes m = addSeconds (60 * m)--> diffMinutes' :: DateTime -> DateTime -> Int-> diffMinutes' x = fromIntegral . diffMinutes x--> diffMinutes :: DateTime -> DateTime -> Integer-> diffMinutes x = (`div` 60) . diffSeconds x- -> addSeconds :: Integer -> DateTime -> DateTime-> addSeconds s dt = fromSeconds $ toSeconds dt + s--> diffSeconds :: DateTime -> DateTime -> Integer-> diffSeconds = (-) `on` toSeconds
+ test/Data/DateTimeTest.hs view
@@ -0,0 +1,51 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Data.DateTimeTest where++import Test.Framework+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.QuickCheck+import Data.Maybe (fromJust)++import Data.Time.Clock (UTCTime)+import Data.DateTime++instance Arbitrary UTCTime where+ arbitrary = do+ offset <- choose (0, 20000) :: Gen Float+ return . fromMJD' $ offset + fromRational startOfTimeMJD+++tests :: [Test]+tests = [ testGroup "properties"+ [ testProperty "MJD" prop_MJD+ , testProperty "Universal" prop_Universal+ , testProperty "StartOfTime" prop_StartOfTime+ , testProperty "SqlString" prop_SqlString+ -- , testProperty "SqlStartOfTime" prop_SqlStartOfTime+ ]+ ]++invariant :: Eq a => (a -> a) -> a -> Bool+invariant f x = f x == x++prop_MJD :: DateTime -> Bool+prop_MJD = invariant $ fromMJD . toMJD++prop_MJD' :: DateTime -> Bool+prop_MJD' = invariant $ fromMJD' . toMJD'++prop_Universal :: DateTime -> Bool+prop_Universal = invariant $ fromUniversalTime . toUniversalTime++prop_StartOfTime :: DateTime -> Bool+prop_StartOfTime _ = toSeconds startOfTime == 0++prop_SqlString :: DateTime -> Bool+prop_SqlString dt = (fromJust . fromSqlString . toSqlString $ dt') == dt'+ where+ Just dt' = fromSqlString . toSqlString $ dt++-- It doesn't seem like this test ever passed, so disabling.+-- prop_SqlStartOfTime :: DateTime -> Bool+-- prop_SqlStartOfTime _ = toSqlString startOfTime == "1970-01-01 00:00:00"
+ test/Suite.hs view
@@ -0,0 +1,8 @@+module Main where++import Test.Framework (defaultMain)++import qualified Data.DateTimeTest++main :: IO ()+main = defaultMain $ Data.DateTimeTest.tests