diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,13 @@ +##### 2.1.0 + add serializeable UTCTimeBin: close copy of UTCTime. + + UTCTime and UTCTimeBin are easily convertible without loss of precision. + + fromUTC is now a class function. It may be necessary to specify the result type. + +##### 2.0.3 + Tz derive Eq, Ord + ##### 2.0.2 changes to Data.Time.Hora.Zone: @@ -48,4 +58,3 @@ ##### 1.0 initial version - diff --git a/hora.cabal b/hora.cabal --- a/hora.cabal +++ b/hora.cabal @@ -1,10 +1,10 @@ name: hora -version: 2.0.2 +version: 2.1.0 build-type: Simple cabal-version: >=1.10 synopsis: date time -description: pico precision * timestamps * timezones * format +description: convenient type, timestamp, timezone, format author: Imants Cekusins maintainer: Imants Cekusins category: System, Time @@ -31,9 +31,7 @@ Data.Time.Hora.Type Data.Time.Hora.Zone Data.Time.Hora.Some - - other-modules: - + ghc-options: -fwarn-unused-imports build-depends: base >=4.7 && <5.0, @@ -83,24 +81,32 @@ main-is: Main.hs other-modules: - Test.TestConvert - Test.TestDiffTime - Test.TestFuture - Test.TestTime - Test.TestDmyHm - Test.TestPico - Test.TestPico2 - Test.TestDatePart - Test.TestUtc - Test.TestZone - Test.TestSome - Test.TestFormat - - + Data.Time.Hora.Format + Data.Time.Hora.Future + Data.Time.Hora.Part + Data.Time.Hora.Some + Data.Time.Hora.Span + Data.Time.Hora.Stamp + Data.Time.Hora.Type + Data.Time.Hora.Zone + Test.TestConvert + Test.TestDiffTime + Test.TestFuture + Test.TestTime + Test.TestDmyHm + Test.TestPico + Test.TestPico2 + Test.TestDatePart + Test.TestUtc + Test.TestZone + Test.TestSome + Test.TestFormat + Test.TestUTCTimeBin build-depends: base >= 4.8, hspec >= 2.1.7, QuickCheck >= 2.8.1, time, timezone-series, timezone-olson, - binary + binary, + bytestring diff --git a/src/Data/Time/Hora/Format.hs b/src/Data/Time/Hora/Format.hs --- a/src/Data/Time/Hora/Format.hs +++ b/src/Data/Time/Hora/Format.hs @@ -5,11 +5,11 @@ format, format') where -import Data.Time.Format (formatTime,defaultTimeLocale,FormatTime(..)) +import Data.String import Data.Time.Clock -import Data.Time.LocalTime as L +import Data.Time.Format (formatTime,defaultTimeLocale,FormatTime(..)) import Data.Time.Hora.Type -import Data.String +import Data.Time.LocalTime as L -- | format as UTC @@ -70,8 +70,8 @@ | D_wk_0_6 -- ^ day of week number, 0 (= Sunday) - 6 (= Saturday) | D_wk -- ^ day of week short | D_week -- ^ day of week long - | Wk_year_Sun -- ^ week of year start sunday - | Wk_year_Mon -- ^ week of year start sunday + | Wk_year_Sun -- ^ week of year start Sunday + | Wk_year_Mon -- ^ week of year start Monday diff --git a/src/Data/Time/Hora/Future.hs b/src/Data/Time/Hora/Future.hs --- a/src/Data/Time/Hora/Future.hs +++ b/src/Data/Time/Hora/Future.hs @@ -1,10 +1,10 @@ module Data.Time.Hora.Future where +import Data.Fixed import Data.Time.Clock -import Data.Time.Hora.Type import Data.Time.Hora.Span +import Data.Time.Hora.Type import Prelude as P -import Data.Fixed {- | 'getCurrentTime' +/- offset diff --git a/src/Data/Time/Hora/Part.hs b/src/Data/Time/Hora/Part.hs --- a/src/Data/Time/Hora/Part.hs +++ b/src/Data/Time/Hora/Part.hs @@ -1,36 +1,50 @@ --- | convert between 'UTCTime' and 'DatePart' +-- | convert between 'UTCTime', 'UTCTimeBin' and 'DatePart' module Data.Time.Hora.Part - (fromUtc,fromUtc', + (-- * FromUTC + FromUTC(..), + fromUtc', + -- * ToUTC ToUTC(..)) where -import Data.Time.Hora.Type -import Data.Time.Hora.Span -import Data.Time.Clock +import Data.Fixed import Data.Time.Calendar +import Data.Time.Clock +import Data.Time.Hora.Span +import Data.Time.Hora.Type import Data.Time.LocalTime as L -import Data.Fixed -{- | UTC -} -fromUtc::Integral a => UTCTime -> DatePart a -fromUtc t0 = - let day1 = utctDay t0::Day - dt1 = utctDayTime t0::DiffTime - (y1,m1,d1) = toGregorian day1 - tod1 = timeToTimeOfDay dt1::TimeOfDay - pico4 = todSec tod1::Fixed E12 - (sec5, MkFixed pico5) = properFraction pico4 - in DatePart { - year = fi y1, - month = fi m1, - day = fi d1, - hour = fi $ todHour tod1, - minute = fi $ todMin tod1, - second = fi sec5, - pico = fi pico5 - } +class FromUTC a where + fromUtc::UTCTime -> a +-- | returns DatePart a in UTC timezone +instance Integral a => FromUTC (DatePart a) where + fromUtc::Integral a => UTCTime -> DatePart a + fromUtc t0 = + let day1 = utctDay t0::Day + dt1 = utctDayTime t0::DiffTime + (y1,m1,d1) = toGregorian day1 + tod1 = timeToTimeOfDay dt1::TimeOfDay + pico4 = todSec tod1::Fixed E12 + (sec5, MkFixed pico5) = properFraction pico4 + in DatePart { + year = fi y1, + month = fi m1, + day = fi d1, + hour = fi $ todHour tod1, + minute = fi $ todMin tod1, + second = fi sec5, + pico = fi pico5 + } + +instance FromUTC UTCTimeBin where + fromUtc::UTCTime -> UTCTimeBin + fromUtc t0 = UTCTimeBin day1 pico1 + where day1 = toModifiedJulianDay $ utctDay t0 + pico1 = diffTimeToPicoseconds $ utctDayTime t0 + + {- | specified time zone Tz (DatePart a) parts show local date & time @@ -93,6 +107,10 @@ zt1 = ZonedTime lt1 tz0 in Just $ zonedTimeToUTC zt1 +instance ToUTC UTCTimeBin where + toUtc (UTCTimeBin day0 pico0) = Just $ UTCTime day1 diff1 + where day1 = ModifiedJulianDay day0 + diff1 = picosecondsToDiffTime pico0 fi::TwoInt a b => a -> b fi = fromIntegral diff --git a/src/Data/Time/Hora/Span.hs b/src/Data/Time/Hora/Span.hs --- a/src/Data/Time/Hora/Span.hs +++ b/src/Data/Time/Hora/Span.hs @@ -15,10 +15,10 @@ nominalDiff ) where +import Data.Fixed import Data.Ratio import Data.Time.Clock import Data.Time.Hora.Type -import Data.Fixed -- | pico in 1 second diff --git a/src/Data/Time/Hora/Stamp.hs b/src/Data/Time/Hora/Stamp.hs --- a/src/Data/Time/Hora/Stamp.hs +++ b/src/Data/Time/Hora/Stamp.hs @@ -7,8 +7,8 @@ import Data.Time.Clock import Data.Time.Hora.Format -import Data.Time.Hora.Type import Data.Time.Hora.Part +import Data.Time.Hora.Type import Data.Time.LocalTime as L @@ -74,4 +74,3 @@ -- | timestamp in specified format, 'TimeZone' | 'TimeZoneSeries' ts'::Tz' tz => [Format] -> tz -> IO (Tz String) ts' lf0 tz0 = withUTCTime $ format' lf0 tz0 - diff --git a/src/Data/Time/Hora/Type.hs b/src/Data/Time/Hora/Type.hs --- a/src/Data/Time/Hora/Type.hs +++ b/src/Data/Time/Hora/Type.hs @@ -1,6 +1,8 @@ module Data.Time.Hora.Type (-- * DatePart DatePart(..), + -- * UTCTimeBin + UTCTimeBin(..), -- * Tz Tz(..), Tz'(..), @@ -8,12 +10,11 @@ TimeSpan(..), TwoInt(..)) where - -import GHC.Generics import Data.Binary import Data.Time.Clock import Data.Time.LocalTime import Data.Time.LocalTime.TimeZone.Series +import GHC.Generics {- | serializeable structure for essential Date, Time parts @@ -29,7 +30,7 @@ minute::a, second::a, pico::a -- ^ excludes seconds. Just fraction as Num - } deriving (Show, Eq, Generic) + } deriving (Show, Generic) instance Functor DatePart where @@ -54,6 +55,7 @@ instance Binary (DatePart String) -- ^ serializeable +deriving instance Eq a => Eq (DatePart a) instance Ord a => Ord (DatePart a) where (<=) a0 b0 = @@ -76,13 +78,31 @@ (Stop b2) -> b2 +-- private data Ord_ = Stop Bool | Continue +{- | 'UTCTimeBin' closely mimicks UTCTime. +'UTCTimeBin' has 'Binary' instance. The only purpose of 'UTCTimeBin' is to offer faster conversion and more compact serialization of 'UTCTime' compared with 'DatePart'. + +see "Data.Time.Hora.Part" for conversion between 'UTCTime' and 'UTCTimeBin' -} +data UTCTimeBin = UTCTimeBin { + modifiedJulianDay::Integer, -- ^ The Modified Julian Day is a standard count of days, with zero being the day 1858-11-17 + diffTimeAsPicoseconds::Integer -- ^ 'DiffTime' expressed as picoseconds + } + deriving (Eq, Show, Generic) + +instance Binary UTCTimeBin +-- ^ serializeable + + {-| 'Tz' ('DatePart' a) parts show local date & time for conversions between timezones see "Data.Time.Hora.Zone" -} data Tz a = Tz TimeZone a deriving (Show,Functor) + +deriving instance Eq a => Eq (Tz a) +deriving instance Ord a => Ord (Tz a) -- | 'TimeZone' | 'TimeZoneSeries' diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,17 +1,18 @@ module Main where -import qualified Test.TestDiffTime as T import qualified Test.TestConvert as Conv +import qualified Test.TestDiffTime as T +import qualified Test.TestDmyHm as D +import qualified Test.TestDatePart as Dp +import qualified Test.TestUtc as U import qualified Test.TestFuture as Fut -import qualified Test.TestTime as Tt import qualified Test.TestPico as P import qualified Test.TestPico2 as P2 -import qualified Test.TestDmyHm as D -import qualified Test.TestDatePart as Dp -import qualified Test.TestUtc as U -import qualified Test.TestZone as Z -import qualified Test.TestSome as Tcom +import qualified Test.TestSome as Tcom import qualified Test.TestFormat as Tf +import qualified Test.TestTime as Tt +import qualified Test.TestUTCTimeBin as Bin +import qualified Test.TestZone as Z main::IO() @@ -28,3 +29,4 @@ Z.main Tcom.main Tf.main + Bin.main diff --git a/test/Test/TestConvert.hs b/test/Test/TestConvert.hs --- a/test/Test/TestConvert.hs +++ b/test/Test/TestConvert.hs @@ -1,9 +1,9 @@ module Test.TestConvert where -import Test.Hspec -import Data.Time.Hora.Type -import Data.Time.Hora.Span import Data.Time.Clock +import Data.Time.Hora.Span +import Data.Time.Hora.Type +import Test.Hspec main::IO() diff --git a/test/Test/TestDatePart.hs b/test/Test/TestDatePart.hs --- a/test/Test/TestDatePart.hs +++ b/test/Test/TestDatePart.hs @@ -1,9 +1,10 @@ module Test.TestDatePart where -import Test.Hspec -import Prelude hiding (until) import Data.Time.Hora.Type -default (Int) +import Prelude hiding (until) +import Test.Hspec + +default (Int) main::IO() diff --git a/test/Test/TestDiffTime.hs b/test/Test/TestDiffTime.hs --- a/test/Test/TestDiffTime.hs +++ b/test/Test/TestDiffTime.hs @@ -1,12 +1,12 @@ module Test.TestDiffTime where -import Test.Hspec -import Debug.Trace -import Data.Time.Clock import Control.Concurrent -import Data.Time.Hora.Stamp +import Data.Time.Clock import Data.Time.Hora.Future as F +import Data.Time.Hora.Stamp import Data.Time.Hora.Type +import Debug.Trace +import Test.Hspec diff --git a/test/Test/TestDmyHm.hs b/test/Test/TestDmyHm.hs --- a/test/Test/TestDmyHm.hs +++ b/test/Test/TestDmyHm.hs @@ -1,7 +1,7 @@ module Test.TestDmyHm where -import Test.Hspec import Data.Time.Hora.Type +import Test.Hspec main::IO() diff --git a/test/Test/TestFormat.hs b/test/Test/TestFormat.hs --- a/test/Test/TestFormat.hs +++ b/test/Test/TestFormat.hs @@ -1,10 +1,10 @@ module Test.TestFormat where -import Test.Hspec -import Debug.Trace -import Data.Time.Hora.Stamp import Data.Time.Hora.Format +import Data.Time.Hora.Stamp import Data.Time.Hora.Type +import Debug.Trace +import Test.Hspec main::IO() diff --git a/test/Test/TestFuture.hs b/test/Test/TestFuture.hs --- a/test/Test/TestFuture.hs +++ b/test/Test/TestFuture.hs @@ -1,11 +1,10 @@ module Test.TestFuture where -import Test.Hspec -import Debug.Trace +import Data.Time.Clock import Data.Time.Hora.Future import Data.Time.Hora.Type -import Data.Time.Clock - +import Debug.Trace +import Test.Hspec main::IO() diff --git a/test/Test/TestPico.hs b/test/Test/TestPico.hs --- a/test/Test/TestPico.hs +++ b/test/Test/TestPico.hs @@ -1,15 +1,16 @@ module Test.TestPico where -import Test.Hspec -import Debug.Trace -import Data.Time.Hora.Part -import Data.Time.Hora.Future as F import Data.Time.Clock +import Data.Time.Hora.Future as F +import Data.Time.Hora.Part +import Data.Time.Hora.Stamp import Data.Time.Hora.Type import Data.Time.LocalTime -import Data.Time.Hora.Stamp +import Debug.Trace import Prelude as P +import Test.Hspec + main::IO() main = hspec $ do describe "Test.TestPico" $ do @@ -36,4 +37,3 @@ diff1 = t2 F.- t1 diff2 = pico d2 P.- (pico d1) diff1 `shouldBe` (Pico diff2) - diff --git a/test/Test/TestPico2.hs b/test/Test/TestPico2.hs --- a/test/Test/TestPico2.hs +++ b/test/Test/TestPico2.hs @@ -1,8 +1,8 @@ module Test.TestPico2 where -import Test.Hspec -import Debug.Trace import Data.Fixed +import Debug.Trace +import Test.Hspec main::IO() diff --git a/test/Test/TestSome.hs b/test/Test/TestSome.hs --- a/test/Test/TestSome.hs +++ b/test/Test/TestSome.hs @@ -1,10 +1,10 @@ module Test.TestSome where -import Test.Hspec -import Debug.Trace import Data.Time.Hora.Some import Data.Time.Hora.Stamp import Data.Time.Hora.Type +import Debug.Trace +import Test.Hspec main::IO() diff --git a/test/Test/TestTime.hs b/test/Test/TestTime.hs --- a/test/Test/TestTime.hs +++ b/test/Test/TestTime.hs @@ -1,10 +1,10 @@ {-# LANGUAGE NoOverloadedStrings #-} module Test.TestTime where -import Test.Hspec -import Debug.Trace -import Data.Time.Hora.Stamp import Data.Time.Hora.Some +import Data.Time.Hora.Stamp +import Debug.Trace +import Test.Hspec main::IO() diff --git a/test/Test/TestUTCTimeBin.hs b/test/Test/TestUTCTimeBin.hs new file mode 100644 --- /dev/null +++ b/test/Test/TestUTCTimeBin.hs @@ -0,0 +1,30 @@ +module Test.TestUTCTimeBin where + +import Data.Binary +import Data.ByteString.Lazy +import Data.Maybe +import Data.Time.Hora.Part +import Data.Time.Hora.Stamp +import Data.Time.Hora.Type +import Debug.Trace +import Test.Hspec + + +main::IO() +main = hspec $ do + describe "round trip convert & serialize UTCTime via UTCTimeBin" $ do + it "round trip convert" $ do + utc1 <- now + let utcbin2 = fromUtc utc1::UTCTimeBin + utc2 = fromJust $ toUtc utcbin2 + traceIO $ show utc1 + traceIO $ show utcbin2 + traceIO $ show utc2 + utc2 `shouldBe` utc1 + it "round trip convert & serialize" $ do + utc10 <- now + let utcbin10 = fromUtc utc10::UTCTimeBin + bin11 = encode utcbin10::ByteString + utcbin12 = decode bin11::UTCTimeBin + utc13 = fromJust $ toUtc utcbin12 + utc10 `shouldBe` utc13 diff --git a/test/Test/TestUtc.hs b/test/Test/TestUtc.hs --- a/test/Test/TestUtc.hs +++ b/test/Test/TestUtc.hs @@ -16,7 +16,7 @@ `shouldBe` Nothing it "round trip" $ do now1 <- getCurrentTime - let dp1 = fromUtc now1 + let dp1 = fromUtc now1::DatePart Int Just now2 = toUtc $ traceShow dp1 dp1 now1 `shouldBe` now2 it "round trip local" $ do @@ -25,4 +25,3 @@ let dp1 = fromUtc' z1 now1::Tz (DatePart Int) Just now2 = toUtc $ traceShow dp1 dp1 now1 `shouldBe` now2 - diff --git a/test/Test/TestZone.hs b/test/Test/TestZone.hs --- a/test/Test/TestZone.hs +++ b/test/Test/TestZone.hs @@ -1,13 +1,14 @@ module Test.TestZone where -import Test.Hspec -import Debug.Trace import Data.Time.Clock -import Data.Time.LocalTime.TimeZone.Olson -import Data.Time.LocalTime.TimeZone.Series +import Data.Time.Hora.Part import Data.Time.Hora.Stamp import Data.Time.Hora.Type -import Data.Time.Hora.Part +import Data.Time.Hora.Zone +import Data.Time.LocalTime.TimeZone.Olson +import Data.Time.LocalTime.TimeZone.Series +import Debug.Trace +import Test.Hspec main::IO() @@ -18,9 +19,13 @@ china1 <- getTimeZoneSeriesFromOlsonFile "./test/TimeSeriesData/ROC" now1 <- now::IO UTCTime traceIO $ "UTC: " ++ (show now1) - traceIO $ "Chile: " ++ (show $ ttz chile1 now1) - traceIO $ "China: " ++ (show $ ttz china1 now1) - 1 `shouldBe` 1 + let chile2 = ttz chile1 now1 + china2 = ttz china1 now1 + china3 = toTimeZone china1 chile2 + traceIO $ "Chile: " ++ (show chile2) + traceIO $ "China: " ++ (show china1) + traceIO $ "China converted: " ++ (show china3) + Just china2 `shouldBe` china3 ttz::TimeZoneSeries -> UTCTime -> Tz (DatePart Int)