diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,10 +1,14 @@ ### hora - convenience date, time types and functions + date, time: - timestamps + convert between UTCTime and date / time parts - parse UTCTime to explicit type + timezone conversion + + timestamps + + typed formats time in future diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,15 @@ +##### 2.0 + *API changes: modules moved & renamed* + + add DatePart -> UTCTime conversion + + add TimeZone conversions + + add Format type + + merge type modules into 1 module : Type + + ##### 1.1.1 Bug fix: Ord datePart diff --git a/hora.cabal b/hora.cabal --- a/hora.cabal +++ b/hora.cabal @@ -1,10 +1,10 @@ name: hora -version: 1.1.1 +version: 2.0 build-type: Simple cabal-version: >=1.10 synopsis: date time -description: date time functions to pico precision +description: pico precision * timestamps * timezones author: Imants Cekusins maintainer: Imants Cekusins category: System, Time @@ -20,19 +20,22 @@ library exposed-modules: - Data.Time.Hora.Convert + Data.Time.Hora.Span Data.Time.Hora.Future - Data.Time.Hora.Timestamp - Data.Time.Hora.Type.DatePart - Data.Time.Hora.Type.Time - Data.Time.Hora.Parse + Data.Time.Hora.Stamp + Data.Time.Hora.Part Data.Time.Hora.Format - - other-modules: + 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, time, + timezone-series, binary hs-source-dirs: src @@ -85,10 +88,16 @@ Test.TestPico Test.TestPico2 Test.TestDatePart + Test.TestUtc + Test.TestZone + Test.TestSome + Test.TestFormat build-depends: base >= 4.8, hspec >= 2.1.7, QuickCheck >= 2.8.1, time, + timezone-series, + timezone-olson, binary diff --git a/src/Data/Time/Hora/Convert.hs b/src/Data/Time/Hora/Convert.hs deleted file mode 100644 --- a/src/Data/Time/Hora/Convert.hs +++ /dev/null @@ -1,76 +0,0 @@ -module Data.Time.Hora.Convert - (-- ** 'TimeSpan' - toPico, - toMilli, - toSec, - -- ** 'Pico' - 'TimeSpan' conversion - picoTimeSpan, - timeSpanPico, - -- ** diff time - toDiffTime, - nominalDiff, - -- ** multipliers - picoSec, - picoMs, - msSec - ) where - -import Data.Ratio -import Data.Time.Clock -import Data.Time.Hora.Type.Time -import Data.Fixed - - --- | pico in 1 second -picoSec::Integral a => a -picoSec = 1000000000000 -- 12 - --- | pico in 1 milli -picoMs::Integral a => a -picoMs = 1000000000 -- 9 - --- | milli in 1 sec -msSec::Integral a => a -msSec = 1000 - -{- | >>> toPico $ Milli 3 -3000000000 -} -toPico::TwoInt a b => TimeSpan a -> b -toPico (Pico i0) = fromIntegral i0 -toPico (Milli i0) = fromIntegral $ i0 * picoMs -toPico (Sec i0) = fromIntegral $ i0 * picoSec - -{- | >>> toMilli $ Sec 5 -5000 -} -toMilli::TwoInt a b => TimeSpan a -> b -toMilli (Pico i0) = fromIntegral $ i0 `div` picoMs -toMilli (Milli i0) = fromIntegral $ i0 -toMilli (Sec i0) = fromIntegral $ i0 * msSec - -{- | >>> toSec $ Milli 781200 -781 -} -toSec::TwoInt a b => TimeSpan a -> b -toSec (Pico i0) = fromIntegral $ i0 `div` picoSec -toSec (Milli i0) = fromIntegral $ i0 `div` msSec -toSec (Sec i0) = fromIntegral $ i0 - - -toDiffTime::Integral a => TimeSpan a -> DiffTime -toDiffTime (Sec s0) = secondsToDiffTime $ fromIntegral s0 -toDiffTime (Pico s0) = picosecondsToDiffTime $ fromIntegral s0 -toDiffTime t0@(Milli s0) = picosecondsToDiffTime $ toPico t0 - - -nominalDiff::Integral a => TimeSpan a -> NominalDiffTime -nominalDiff ts0 = let s1 = toPico ts0::Integer - in fromRational $ s1 % picoSec - - - -picoTimeSpan::Num a => Pico -> TimeSpan a -picoTimeSpan (MkFixed p0) = Pico $ fromIntegral p0 - - -timeSpanPico::Integral a => TimeSpan a -> Pico -timeSpanPico ts0 = MkFixed $ fromIntegral p0 - where p0 = toPico ts0 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 @@ -1,43 +1,116 @@ -module Data.Time.Hora.Format where +module Data.Time.Hora.Format + (-- * type + Format(..), + -- * format + format, + format') where -import Data.Time.Format (formatTime,defaultTimeLocale) +import Data.Time.Format (formatTime,defaultTimeLocale,FormatTime(..)) import Data.Time.Clock import Data.Time.LocalTime as L -import Data.Time.Calendar -import Data.Time.Hora.Type.Time -import Text.Printf +import Data.Time.Hora.Type +import Data.String -{- | yyyy-mm-dd UTC -} -iso::UTCTime -> String -iso t0 = showGregorian $ utctDay t0 +-- | format as UTC +format::[Format] -> UTCTime -> String +format lf0 utc0 = withDefaultLocale (build lf0) utc0 -{- | yyyy-mm-dd local -} -iso'::TimeZone -> UTCTime -> Tz String -iso' tz0 utc0 = - let lt2 = L.utcToLocalTime tz0 utc0 - day2 = localDay lt2 - (y3,m3,d3) = toGregorian day2 - in Tz tz0 $ printf "%04v-%02v-%02v" y3 m3 d3 +-- | format as local time in specified timezone +format'::Tz' tz => + [Format] -> tz -> UTCTime -> Tz String +format' lf0 tz0 utc0 = Tz tz1 $ withDefaultLocale (build lf0) zt1 + where zt1 = utcToZonedTime tz1 utc0::ZonedTime + tz1 = tz' tz0 utc0 -{- | yyyymmdd UTC -} -ymd::UTCTime -> String -ymd utc0 = formatTime defaultTimeLocale "%Y%m%d" utc0 +withDefaultLocale::FormatTime t => + String -- ^ format. see 'formatTime' + -> t + -> String +withDefaultLocale = formatTime defaultTimeLocale -{- | yyyymmdd local -} -ymd'::TimeZone -> UTCTime -> Tz String -ymd' tz0 utc0 = - let lt2 = L.utcToLocalTime tz0 utc0 - day2 = localDay lt2 - (y3,m3,d3) = toGregorian day2 - in Tz tz0 $ printf "%04v%02v%02v" y3 m3 d3 - +instance IsString Format where + fromString = Raw +{- ^ enter 'Raw' 'String' as ordinary 'String' with -formatUTCTime::String -- ^ format. see 'formatTime' - -> UTCTime - -> String -formatUTCTime format0 = formatTime defaultTimeLocale format0 - +@ +\{\-\# LANGUAGE OverloadedStrings \#\-\} +@ -} + +{- | \*0: 0 padded + +see 'formatTime' +-} +data Format = + Raw String + | Tab + | Crlf -- ^ new line + | Offset -- ^ time zone + | Zone -- ^ time zone name + | Hm -- ^ %H:%M + | Hms -- ^ %H:%M:%S + | AM -- ^ AM PM + | Am -- ^ am pm + | H_24 -- ^ 24-hour *0 + | H_12 -- ^ 12-hour *0 + | Min -- ^ minute *0 + | S -- ^ second *0 + | Fraction_fixed -- ^ pico precision *0 + | Fraction -- ^ .12 for 0.12 second. Pico precision, no trailing 0 + | Y_m_d -- ^ %Y-%m-%d + | Y -- ^ year + | Month -- ^ month name long + | Mth -- ^ month name short + | Mth_1_12 -- ^ month *0 + | D -- ^ day *0 + | D_wk_1_7 -- ^ day of week for Week Date format, 1 - 7 + | 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 + + + + +{-| build format string from 'Format' -} +class Build f where + build::f -> String + + +instance Build [Format] where + build = concat . (build <$>) + + +instance Build Format where + build f0 = case f0 of + Raw s1 -> s1 + Tab -> "%t" + Crlf -> "%n" + Offset -> "%z" + Zone -> "%Z" + Hm -> "%R" + Hms -> "%T" + AM -> "%p" + Am -> "%P" + H_24 -> "%H" + H_12 -> "%I" + Min -> "%M" + S -> "%S" + Fraction_fixed -> "%q" + Fraction -> "%Q" + Y_m_d -> "%F" + Y -> "%Y" + Month -> "%B" + Mth -> "%b" + Mth_1_12 -> "%m" + D -> "%d" + D_wk_1_7 -> "%u" + D_wk_0_6 -> "%w" + D_wk -> "%a" + D_week -> "%A" + Wk_year_Sun -> "%U" + Wk_year_Mon -> "%W" 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,8 +1,8 @@ module Data.Time.Hora.Future where import Data.Time.Clock -import Data.Time.Hora.Type.Time -import Data.Time.Hora.Convert +import Data.Time.Hora.Type +import Data.Time.Hora.Span import Prelude as P import Data.Fixed @@ -27,7 +27,7 @@ {- | Difference between times with pico precision - return TimeSpan for ease of conversion with "Data.Time.Hora.Convert" -} +return TimeSpan for ease of conversion with "Data.Time.Hora.Span" -} class PicoDiff a where (-)::a -> a -> TimeSpan Integer diff --git a/src/Data/Time/Hora/Parse.hs b/src/Data/Time/Hora/Parse.hs deleted file mode 100644 --- a/src/Data/Time/Hora/Parse.hs +++ /dev/null @@ -1,50 +0,0 @@ -module Data.Time.Hora.Parse where - -import Data.Time.Hora.Type.DatePart as M -import Data.Time.Hora.Type.Time -import Data.Time.Clock -import Data.Time.Calendar -import Data.Time.LocalTime as L -import Data.Fixed - - -{- | UTC -} -parse::Num a => UTCTime -> DatePart a -parse 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 = fromIntegral y1, - month = fromIntegral m1, - day = fromIntegral d1, - hour = fromIntegral $ todHour tod1, - minute = fromIntegral $ todMin tod1, - second = fromIntegral sec5, - pico = fromIntegral pico5 - } - - -{- | specified time zone -} -parse'::Num a => - TimeZone -> UTCTime -> Tz (DatePart a) -parse' tz0 utc0 = - let lt2 = L.utcToLocalTime tz0 utc0 - day2 = localDay lt2 - time2 = localTimeOfDay lt2 - (y3,m3,d3) = toGregorian day2 - d4 = DatePart{ - year = fromIntegral y3, - month = fromIntegral m3, - day = fromIntegral d3, - hour = fromIntegral $ todHour time2, - minute = fromIntegral $ todMin time2, - second = fromIntegral sec5, - pico = fromIntegral pico5 - } - pico4 = todSec time2::Fixed E12 - (sec5, MkFixed pico5) = properFraction pico4 - in Tz tz0 d4 diff --git a/src/Data/Time/Hora/Part.hs b/src/Data/Time/Hora/Part.hs new file mode 100644 --- /dev/null +++ b/src/Data/Time/Hora/Part.hs @@ -0,0 +1,98 @@ +-- | convert between 'UTCTime' and 'DatePart' +module Data.Time.Hora.Part + (fromUtc,fromUtc', + ToUTC(..)) where + +import Data.Time.Hora.Type +import Data.Time.Hora.Span +import Data.Time.Clock +import Data.Time.Calendar +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 + } + + +{- | specified time zone + +Tz (DatePart a) parts show local date & time + +see also "Data.Time.Hora.Zone" -} +fromUtc'::(Tz' tz, Integral a) => + tz -> UTCTime -> Tz (DatePart a) +fromUtc' tz0 utc0 = + let tz1 = tz' tz0 utc0 + lt2 = L.utcToLocalTime tz1 utc0 + day2 = localDay lt2 + time2 = localTimeOfDay lt2 + (y3,m3,d3) = toGregorian day2 + d4 = DatePart{ + year = fi y3, + month = fi m3, + day = fi d3, + hour = fi $ todHour time2, + minute = fi $ todMin time2, + second = fi sec5, + pico = fi pico5 + } + pico4 = todSec time2::Fixed E12 + (sec5, MkFixed pico5) = properFraction pico4 + in Tz tz1 d4 + + +{-| convert 'DatePart' -> 'UTCTime' + +Invalid date returns Nothing -} +class ToUTC a where + toUtc::a -> Maybe UTCTime + + +instance Integral a => ToUTC (DatePart a) where + toUtc dp0 = + let h1 = hour dp0 * 60 * 60 -- as second + min1 = minute dp0 * 60 -- as second + s2 = second dp0 + h1 + min1 + diff1 = secondsToDiffTime $ fi s2 + diff2 = picosecondsToDiffTime $ fi $ pico dp0 + + mday1 = fromGregorianValid (fi $ year dp0) + (fi $ month dp0) $ fi $ day dp0 + in mday1 >>= \day1 -> Just $ UTCTime day1 $ diff1 + diff2 +-- ^ assumes DatePart is UTC + + +instance Integral a => ToUTC (Tz (DatePart a)) where + toUtc (Tz tz0 dp0) = + let s1 = toPico $ Sec $ second dp0 + mtod1 = makeTimeOfDayValid (fi $ hour dp0) + (fi $ minute dp0) + (timeSpanPico $ Pico s1 + (Pico $ fi $ pico dp0)) + mday1 = fromGregorianValid (fi $ year dp0) + (fi $ month dp0) $ fi $ day dp0 + in mday1 >>= \day1 -> + mtod1 >>= \tod1 -> + let lt1 = LocalTime day1 tod1 + zt1 = ZonedTime lt1 tz0 + in Just $ zonedTimeToUTC zt1 + + +fi::TwoInt a b => a -> b +fi = fromIntegral diff --git a/src/Data/Time/Hora/Some.hs b/src/Data/Time/Hora/Some.hs new file mode 100644 --- /dev/null +++ b/src/Data/Time/Hora/Some.hs @@ -0,0 +1,36 @@ +{-| common format shortcuts -} +module Data.Time.Hora.Some where + +import Data.Time.Hora.Format + + +{- | yyyy-mm-dd -} +iso::[Format] +iso = [Y_m_d] + + +{- | yyyymmdd -} +ymd::[Format] +ymd = [Y, Mth_1_12, D] + + +{- | time.fraction no trailing 0 - varying length + +09:10:58.030311306 -} +tf::[Format] +tf = [Hms, Fraction] + + +{- | time + +09:11:18 -} +t::[Format] +t = [Hms] + + + +{- | date, time + +2016-12-14 09:16:23 -} +dt::[Format] +dt = [Y_m_d, Raw " ", Hms] diff --git a/src/Data/Time/Hora/Span.hs b/src/Data/Time/Hora/Span.hs new file mode 100644 --- /dev/null +++ b/src/Data/Time/Hora/Span.hs @@ -0,0 +1,76 @@ +module Data.Time.Hora.Span + (-- ** 'TimeSpan' + toPico, + toMilli, + toSec, + -- ** multipliers + picoSec, + picoMs, + msSec, + -- ** 'Pico' - 'TimeSpan' conversion + picoTimeSpan, + timeSpanPico, + -- ** diff time + toDiffTime, + nominalDiff + ) where + +import Data.Ratio +import Data.Time.Clock +import Data.Time.Hora.Type +import Data.Fixed + + +-- | pico in 1 second +picoSec::Integral a => a +picoSec = 1000000000000 -- 12 + +-- | pico in 1 milli +picoMs::Integral a => a +picoMs = 1000000000 -- 9 + +-- | milli in 1 sec +msSec::Integral a => a +msSec = 1000 + +{- | >>> toPico $ Milli 3 +3000000000 -} +toPico::TwoInt a b => TimeSpan a -> b +toPico (Pico i0) = fromIntegral i0 +toPico (Milli i0) = fromIntegral $ i0 * picoMs +toPico (Sec i0) = fromIntegral $ i0 * picoSec + +{- | >>> toMilli $ Sec 5 +5000 -} +toMilli::TwoInt a b => TimeSpan a -> b +toMilli (Pico i0) = fromIntegral $ i0 `div` picoMs +toMilli (Milli i0) = fromIntegral $ i0 +toMilli (Sec i0) = fromIntegral $ i0 * msSec + +{- | >>> toSec $ Milli 781200 +781 -} +toSec::TwoInt a b => TimeSpan a -> b +toSec (Pico i0) = fromIntegral $ i0 `div` picoSec +toSec (Milli i0) = fromIntegral $ i0 `div` msSec +toSec (Sec i0) = fromIntegral $ i0 + + +toDiffTime::Integral a => TimeSpan a -> DiffTime +toDiffTime (Sec s0) = secondsToDiffTime $ fromIntegral s0 +toDiffTime (Pico s0) = picosecondsToDiffTime $ fromIntegral s0 +toDiffTime t0@(Milli s0) = picosecondsToDiffTime $ toPico t0 + + +nominalDiff::Integral a => TimeSpan a -> NominalDiffTime +nominalDiff ts0 = let s1 = toPico ts0::Integer + in fromRational $ s1 % picoSec + + + +picoTimeSpan::Integral a => Pico -> TimeSpan a +picoTimeSpan (MkFixed p0) = Pico $ fromIntegral p0 + + +timeSpanPico::Integral a => TimeSpan a -> Pico +timeSpanPico ts0 = MkFixed $ fromIntegral p0 + where p0 = toPico ts0 diff --git a/src/Data/Time/Hora/Stamp.hs b/src/Data/Time/Hora/Stamp.hs new file mode 100644 --- /dev/null +++ b/src/Data/Time/Hora/Stamp.hs @@ -0,0 +1,77 @@ +module Data.Time.Hora.Stamp + (-- * numerical + Now(..), + -- * 'String' + Timestamp(..), + ts') where + +import Data.Time.Clock +import Data.Time.Hora.Format +import Data.Time.Hora.Type +import Data.Time.Hora.Part +import Data.Time.LocalTime as L + + +-- | numeric +class Now a where + now::IO a + +instance Integral a => Now (DatePart a) where + now = withUTCTime fromUtc +{-^ UTC + +>>> now::IO(DatePart Int) +DatePart {year = 2016, month = 12, day = 15, hour = 10, minute = 20, second = 31, pico = 494880242000} +-} + + +instance Now UTCTime where + now = getCurrentTime +{- ^ >>> now::IO UTCTime +2016-12-15 10:20:54.664155598 UTC -} + + +instance Integral a => Now (Tz (DatePart a)) where + now = withTimeZone fromUtc' +{- ^ local timezone + +'Tz' ('DatePart' a) parts show local date & time + +>>> now::IO(Tz (DatePart Int)) +Tz CET (DatePart {year = 2016, month = 12, day = 15, hour = 11, minute = 21, second = 21, pico = 657029375000}) -} + + + +withTimeZone::(TimeZone -> UTCTime -> Tz a) -> IO (Tz a) +withTimeZone fn0 = do + z1 <- getCurrentTimeZone -- CET | CEST + t1 <- getCurrentTime + pure $ fn0 z1 t1 + + +withUTCTime::(UTCTime -> a) -> IO a +withUTCTime fn0 = do + t1 <- getCurrentTime + pure $ fn0 t1 + + +{- | timestamp in specified format + +see "Data.Time.Hora.Some" for common ['Format']s -} +class Timestamp out where + ts::[Format] -> IO out + + +instance Timestamp String where + ts lf0 = withUTCTime $ format lf0 +-- ^ UTC + +instance Timestamp (Tz String) where + ts lf0 = withTimeZone $ format' lf0 +-- ^ local timezone + + +-- | 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/Timestamp.hs b/src/Data/Time/Hora/Timestamp.hs deleted file mode 100644 --- a/src/Data/Time/Hora/Timestamp.hs +++ /dev/null @@ -1,111 +0,0 @@ -module Data.Time.Hora.Timestamp - (-- ** numerical - now, now', - -- ** string - t, tf, - dt, - d, d') where - -import Data.Time.Clock -import Data.Time.Hora.Format -import Data.Time.Hora.Type.DatePart -import Data.Time.Hora.Type.Time -import Data.Time.Hora.Parse -import Data.Time.LocalTime as L - - -{-| UTC - ->>> now -DatePart {year = 2016, month = 12, day = 14, hour = 9, minute = 7, second = 10, pico = 233275605000} --} -now::Num a => IO (DatePart a) -now = withUTCTime parse - - -{-| current timezone - ->>> now' -Tz CET (DatePart {year = 2016, month = 12, day = 14, hour = 10, minute = 7, second = 26, pico = 498313115000}) --} -now'::Num a => IO (Tz (DatePart a)) -now' = withTimeZone parse' - - - -{- | time.fraction UTC - ->>> tf -09:10:58.030311306 --} -tf::IO String -tf = do - utc0 <- getCurrentTime - pure $ formatUTCTime "%T%Q" utc0 - - -{- | time UTC - ->>> t -09:11:18 --} -t::IO String -t = do - utc0 <- getCurrentTime - pure $ formatUTCTime "%T" utc0 - - -{- | date, time UTC - ->>> dt -"2016-12-14 09:16:23" --} -dt::IO String -dt = do - utc0 <- getCurrentTime - pure $ formatUTCTime "%F %T" utc0 - - - -{- | date yyyymmdd - -UTC - ->>> d -"20161214" --} -d::IO String -d = withUTCTime ymd - - -{- | date yyyymmdd - -local timezone - ->>> d' -Tz CET "20161214" --} -d'::IO (Tz String) -d' = withTimeZone ymd' - - - -type WithLocalTimeZone a = TimeZone -> UTCTime -> Tz a -type WithUTCTime a = UTCTime -> a - - -{- | do calc with current time zone from 'getCurrentTimeZone' - - probably don't need it --} -withTimeZone::WithLocalTimeZone a -> IO (Tz a) -withTimeZone fn0 = do - z1 <- getCurrentTimeZone -- CET | CEST - t1 <- getCurrentTime - pure $ fn0 z1 t1 - - -withUTCTime::WithUTCTime a -> IO a -withUTCTime fn0 = do - t1 <- getCurrentTime - pure $ fn0 t1 diff --git a/src/Data/Time/Hora/Type.hs b/src/Data/Time/Hora/Type.hs new file mode 100644 --- /dev/null +++ b/src/Data/Time/Hora/Type.hs @@ -0,0 +1,178 @@ +module Data.Time.Hora.Type + (-- * DatePart + DatePart(..), + -- * Tz + Tz(..), + Tz'(..), + -- * TimeSpan + TimeSpan(..), + TwoInt(..)) where + + +import GHC.Generics +import Data.Binary +import Data.Time.Clock +import Data.Time.LocalTime +import Data.Time.LocalTime.TimeZone.Series + + +{- | serializeable structure for essential Date, Time parts + +see "Data.Time.Hora.Part" for conversion between 'UTCTime' and 'DatePart' -} +data DatePart a = DatePart { + year::a, + month::a, + day::a, + hour::a, + minute::a, + second::a, + pico::a -- ^ excludes seconds. Just fraction as Num + } deriving (Show, Eq, Generic) + + +instance Functor DatePart where + fmap f0 d0 = d0 { + day = f0 (day d0), + month = f0 (month d0), + year = f0 (year d0), + hour = f0 (hour d0), + minute = f0 (minute d0), + second = f0 (second d0), + pico = f0 (pico d0) + } +-- ^ for ease of conversion + + +instance Binary (DatePart Int) +-- ^ serializeable + +instance Binary (DatePart Integer) +-- ^ serializeable + +instance Binary (DatePart String) +-- ^ serializeable + + +instance Ord a => Ord (DatePart a) where + (<=) a0 b0 = + let y1 = (year a0, year b0) + m1 = (month a0, month b0) + d1 = (day a0, day b0) + h1 = (hour a0, hour b0) + min1 = (minute a0, minute b0) + s1 = (second a0, second b0) + p1 = (pico a0, pico b0) + l1 = [y1,m1,d1,h1,min1,s1,p1] + f1 (Stop bo1) _ = Stop bo1 + f1 Continue (a1, b1) + | a1 < b1 = Stop True + | a1 == b1 = Continue + | a1 > b1 = Stop False + res2 = foldl f1 Continue l1 + in case res2 of + Continue -> True + (Stop b2) -> b2 + + +data Ord_ = Stop Bool | Continue + + +{-| '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) + + +-- | 'TimeZone' | 'TimeZoneSeries' +class Tz' tz where + tz'::tz -> UTCTime -> TimeZone + +instance Tz' TimeZone where + tz' tz0 _ = tz0 + +instance Tz' TimeZoneSeries where + tz' = timeZoneFromSeries +-- ^ see "Data.Time.Hora.Zone" re: 'TimeZoneSeries' + + +{- | second and fractions + +see "Data.Time.Hora.Span" for conversion -} +data TimeSpan a = Sec a + | Pico a + | Milli a deriving (Show, Functor) + + +-- | constraint +type TwoInt a b = (Integral a, Integral b) + + +{- | ! fromInteger returns 'Pico'. assumes the value is Pico seconds + +>>> Milli 397100 + (Sec 2) + 37891470000 +Pico 399137891470000 +>>> Milli 397100 + (Sec 2) + (Pico 37891470000) +Pico 399137891470000 +>>> 3 * (Sec 10) == (Sec 30) +True +>>> 3 * (Pico 10) == (Pico 30) +True +>>> 300 * (Milli 1000) == (Milli 300000) +True -} +instance Integral a => Num (TimeSpan a) where + (+) = withPico (+) + (*) = withPico (*) + abs a0 = if a0 > Pico 0 then a0 else - a0 + signum a0 + | a0 > Pico 0 = 1 + | a0 < Pico 0 = - 1 + | otherwise = 0 + fromInteger i0 = Pico $ fromIntegral i0 + (-) = withPico (-) + + +{- | >>> Sec 1 == Milli 1000 +True -} +instance (Eq a, Integral a) => Eq (TimeSpan a) where + (==) (Sec a0) (Sec b0) = a0 == b0 + (==) (Milli a0) (Milli b0) = a0 == b0 + (==) (Pico a0) (Pico b0) = a0 == b0 + (==) a0 b0 = a1 == b1 + where a1 = toPico a0::Integer + b1 = toPico b0::Integer + + +{- | >>> Sec 1 > Milli 500 +True -} +instance (Ord a, Integral a) => Ord (TimeSpan a) where + (<=) (Sec a0) (Sec b0) = a0 <= b0 + (<=) (Milli a0) (Milli b0) = a0 <= b0 + (<=) (Pico a0) (Pico b0) = a0 <= b0 + (<=) a0 b0 = a1 <= b1 + where a1 = toPico a0::Integer + b1 = toPico b0::Integer + + +withPico::Integral a => (a -> a -> a) -> + TimeSpan a -> TimeSpan a -> TimeSpan a +withPico fn0 a0 b0 = Pico $ fn0 a1 b1 + where a1 = toPico a0 + b1 = toPico b0 + + +{- | >>> toPico (Milli 1) + 1000000000 -} +toPico::TwoInt a b => TimeSpan a -> b +toPico (Pico i0) = fromIntegral i0 +toPico (Milli i0) = fromIntegral $ i0 * picoMs +toPico (Sec i0) = fromIntegral $ i0 * picoSec + + + +-- | pico in 1 second +picoSec::Integral a => a +picoSec = 1000000000000 -- 12 + +-- | pico in 1 milli +picoMs::Integral a => a +picoMs = 1000000000 -- 9 diff --git a/src/Data/Time/Hora/Type/DatePart.hs b/src/Data/Time/Hora/Type/DatePart.hs deleted file mode 100644 --- a/src/Data/Time/Hora/Type/DatePart.hs +++ /dev/null @@ -1,55 +0,0 @@ -module Data.Time.Hora.Type.DatePart where - -import GHC.Generics -import Data.Binary - - --- | Date, Time parts -data DatePart a = DatePart { - year::a, - month::a, - day::a, - hour::a, - minute::a, - second::a, - pico::a -- ^ excludes seconds. Just fraction as Num - } deriving (Show, Eq, Generic) - - -instance Functor DatePart where - fmap f0 d0 = d0 { - day = f0 (day d0), - month = f0 (month d0), - year = f0 (year d0), - hour = f0 (hour d0), - minute = f0 (minute d0), - second = f0 (second d0), - pico = f0 (pico d0) - } - -instance Binary (DatePart Int) -instance Binary (DatePart String) - - -instance Ord (DatePart Int) where - (<=) a0 b0 = - let y1 = (year a0, year b0) - m1 = (month a0, month b0) - d1 = (day a0, day b0) - h1 = (hour a0, hour b0) - min1 = (minute a0, minute b0) - s1 = (second a0, second b0) - p1 = (pico a0, pico b0) - l1 = [y1,m1,d1,h1,min1,s1,p1] - f1 (Stop bo1) _ = Stop bo1 - f1 Continue (a1, b1) - | a1 < b1 = Stop True - | a1 == b1 = Continue - | a1 > b1 = Stop False - res2 = foldl f1 Continue l1 - in case res2 of - Continue -> True - (Stop b2) -> b2 - - -data Ord_ = Stop Bool | Continue diff --git a/src/Data/Time/Hora/Type/Time.hs b/src/Data/Time/Hora/Type/Time.hs deleted file mode 100644 --- a/src/Data/Time/Hora/Type/Time.hs +++ /dev/null @@ -1,89 +0,0 @@ -module Data.Time.Hora.Type.Time - (Tz(..), - TwoInt(..), - TimeSpan(..)) where - -import Data.Time.LocalTime - - -data Tz a = Tz TimeZone a deriving (Show,Functor) - - --- | various precision -data TimeSpan a = Sec a - | Pico a - | Milli a deriving (Show, Functor) - - --- | constraint -type TwoInt a b = (Integral a, Integral b) - - - - -{- | ! fromInteger returns 'Pico'. assumes the value is Pico seconds - ->>> Milli 397100 + (Sec 2) + 37891470000 -Pico 399137891470000 --} -instance Integral a => Num (TimeSpan a) where - (+) = withPico (+) - (*) = withPico (*) - abs a0 = if a0 > Pico 0 then a0 else - a0 - signum a0 - | a0 > Pico 0 = 1 - | a0 < Pico 0 = - 1 - | otherwise = 0 - fromInteger i0 = Pico $ fromIntegral i0 - (-) = withPico (-) - -{- | safe to mix sec \/ pico \/ milli - ->>> Sec 1 == Milli 1000 -True --} -instance (Eq a, Integral a) => Eq (TimeSpan a) where - (==) (Sec a0) (Sec b0) = a0 == b0 - (==) (Milli a0) (Milli b0) = a0 == b0 - (==) (Pico a0) (Pico b0) = a0 == b0 - (==) a0 b0 = a1 == b1 - where a1 = toPico a0::Integer - b1 = toPico b0::Integer - - -{- | safe to mix sec \/ pico \/ milli - ->>> Sec 1 > Milli 500 -True -} -instance (Ord a, Integral a) => Ord (TimeSpan a) where - (<=) (Sec a0) (Sec b0) = a0 <= b0 - (<=) (Milli a0) (Milli b0) = a0 <= b0 - (<=) (Pico a0) (Pico b0) = a0 <= b0 - (<=) a0 b0 = a1 <= b1 - where a1 = toPico a0::Integer - b1 = toPico b0::Integer - - -withPico::Integral a => (a -> a -> a) -> - TimeSpan a -> TimeSpan a -> TimeSpan a -withPico fn0 a0 b0 = Pico $ fn0 a1 b1 - where a1 = toPico a0 - b1 = toPico b0 - - -{- | >>> toPico (Milli 1) - 1000000000 -} -toPico::TwoInt a b => TimeSpan a -> b -toPico (Pico i0) = fromIntegral i0 -toPico (Milli i0) = fromIntegral $ i0 * picoMs -toPico (Sec i0) = fromIntegral $ i0 * picoSec - - - --- | pico in 1 second -picoSec::Integral a => a -picoSec = 1000000000000 -- 12 - --- | pico in 1 milli -picoMs::Integral a => a -picoMs = 1000000000 -- 9 diff --git a/src/Data/Time/Hora/Zone.hs b/src/Data/Time/Hora/Zone.hs new file mode 100644 --- /dev/null +++ b/src/Data/Time/Hora/Zone.hs @@ -0,0 +1,43 @@ +{-| to get timezone-series data, see + + +see also + + +for complete example with olson, see Test.TestZone in this package + +@ +import Data.Time.LocalTime.TimeZone.Olson + +-- see man tzfile for common olson file locations +getTimeZoneSeriesFromOlsonFile "\/usr\/share\/zoneinfo\/Chile\/Continental" >>= + \\(chile1::TimeZoneSeries) -> ... +@ -} +module Data.Time.Hora.Zone where + +import Data.Time.Clock +import Data.Time.LocalTime.TimeZone.Series +import Data.Time.Hora.Part +import Data.Time.Hora.Type + + +{-| convert __a__ to __b__ in specified 'TimeZone' -} +class ToTimeZone a b where + toTimeZone::TimeZoneSeries -> a -> b + + +instance Integral a => + ToTimeZone UTCTime + (Tz (DatePart a)) where + toTimeZone series0 utc0 = + let tz1 = timeZoneFromSeries series0 utc0 + in fromUtc' tz1 utc0 +-- ^ similar to 'fromUtc'' but safer around dates when e.g. Summer time changes + + +instance Integral a => + ToTimeZone (Tz (DatePart a)) + (Maybe (Tz (DatePart a))) where + toTimeZone series0 dp0 = toUtc dp0 >>= Just . (toTimeZone series0) +-- ^ convert 'DatePart' from one 'TimeZone' to another + diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -8,6 +8,10 @@ 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.TestFormat as Tf main::IO() @@ -20,3 +24,7 @@ D.main P2.main Dp.main + U.main + Z.main + Tcom.main + Tf.main diff --git a/test/Test/TestConvert.hs b/test/Test/TestConvert.hs --- a/test/Test/TestConvert.hs +++ b/test/Test/TestConvert.hs @@ -1,8 +1,8 @@ module Test.TestConvert where import Test.Hspec -import Data.Time.Hora.Type.Time -import Data.Time.Hora.Convert +import Data.Time.Hora.Type +import Data.Time.Hora.Span import Data.Time.Clock diff --git a/test/Test/TestDatePart.hs b/test/Test/TestDatePart.hs --- a/test/Test/TestDatePart.hs +++ b/test/Test/TestDatePart.hs @@ -2,7 +2,7 @@ import Test.Hspec import Prelude hiding (until) -import Data.Time.Hora.Type.DatePart +import Data.Time.Hora.Type default (Int) @@ -21,6 +21,14 @@ it "Ord" $ do now `shouldSatisfy` (< until) until `shouldSatisfy` (< stop) + it "*" $ do + 3 * (Sec 10) `shouldBe` (Sec 30) + 300 * (Sec 1000) `shouldBe` (Sec 300000) + 300 * (Milli 1000) `shouldBe` (Milli 300000) + Milli 300 + (Milli 1000) `shouldBe` (Milli 1300) + Sec 1 + (Milli 300) `shouldBe` (Milli 1300) + 3 * (Pico 10) `shouldBe` (Pico 30) + Milli 397100 + (Sec 2) + 37891470000 `shouldBe` (Milli 397100 + (Sec 2) + (Pico 37891470000)) now::DatePart Int diff --git a/test/Test/TestDiffTime.hs b/test/Test/TestDiffTime.hs --- a/test/Test/TestDiffTime.hs +++ b/test/Test/TestDiffTime.hs @@ -4,9 +4,9 @@ import Debug.Trace import Data.Time.Clock import Control.Concurrent -import Data.Time.Hora.Timestamp +import Data.Time.Hora.Stamp import Data.Time.Hora.Future as F -import Data.Time.Hora.Type.Time +import Data.Time.Hora.Type @@ -21,10 +21,6 @@ traceIO $ show diff3 1 `shouldBe` 1 it "DmyHmP" $ do - dmy2 <- now + dmy2 <- now::IO (DatePart Int) traceIO $ "TestDiffTime" ++ (show dmy2) - 1 `shouldBe` 1 - it "dmy_local" $ do - Tz tz1 l1 <- d' - traceIO $ show l1 1 `shouldBe` 1 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.DatePart +import Data.Time.Hora.Type main::IO() diff --git a/test/Test/TestFormat.hs b/test/Test/TestFormat.hs new file mode 100644 --- /dev/null +++ b/test/Test/TestFormat.hs @@ -0,0 +1,34 @@ +module Test.TestFormat where + +import Test.Hspec +import Debug.Trace +import Data.Time.Hora.Stamp +import Data.Time.Hora.Format +import Data.Time.Hora.Type + + +main::IO() +main = hspec $ do + describe "Test.TestFormat" $ do + it "prefix tab \n Offset" $ do + ts ["prefix", Tab, "postfix", Crlf, Offset] >>= utc + 1 `shouldBe` 1 + it "zone hm am" $ do + ts [Zone, " ", Hm, " ", AM, " ", Am, " ", H_12, " ", H_24] >>= utc + 1 `shouldBe` 1 + it "fraction fixed, fraction" $ do + ts [Fraction, " ", Fraction_fixed] >>= utc + 1 `shouldBe` 1 + it "Months" $ do + ts [Month, " ", Mth, " ", Mth_1_12] >>= utc + 1 `shouldBe` 1 + it "day of week" $ do + ts [D_week, " ", D_wk, " ", D_wk_0_6, " ", D_wk_1_7] >>= utc + 1 `shouldBe` 1 + it "week of year" $ do + ts [Wk_year_Mon, " ", Wk_year_Sun] >>= utc + 1 `shouldBe` 1 + + +utc::Tz String -> IO() +utc = traceIO . show diff --git a/test/Test/TestFuture.hs b/test/Test/TestFuture.hs --- a/test/Test/TestFuture.hs +++ b/test/Test/TestFuture.hs @@ -3,7 +3,7 @@ import Test.Hspec import Debug.Trace import Data.Time.Hora.Future -import Data.Time.Hora.Type.Time +import Data.Time.Hora.Type import Data.Time.Clock diff --git a/test/Test/TestPico.hs b/test/Test/TestPico.hs --- a/test/Test/TestPico.hs +++ b/test/Test/TestPico.hs @@ -2,38 +2,37 @@ import Test.Hspec import Debug.Trace -import Data.Time.Hora.Parse +import Data.Time.Hora.Part import Data.Time.Hora.Future as F import Data.Time.Clock -import Data.Time.Hora.Type.DatePart -import Data.Time.Hora.Type.Time +import Data.Time.Hora.Type import Data.Time.LocalTime -import Data.Time.Hora.Timestamp +import Data.Time.Hora.Stamp import Prelude as P main::IO() main = hspec $ do describe "Test.TestPico" $ do it "now" $ do - now >>= traceIO . show + (now::IO (DatePart Int)) >>= traceIO . show 1 `shouldBe` 1 it "parse DmyHmsFormat" $ do - getCurrentTime >>= pure . parse >>= \(f1::DatePart Int) -> traceIO $ show f1 + getCurrentTime >>= pure . fromUtc >>= \(f1::DatePart Int) -> traceIO $ show f1 1 `shouldBe` 1 it "parse DmyHmP" $ do - getCurrentTime >>= pure . parse >>= \(f1::DatePart Int) -> traceIO $ show f1 + getCurrentTime >>= pure . fromUtc >>= \(f1::DatePart Int) -> traceIO $ show f1 1 `shouldBe` 1 it "parse' DmyHmP curr timezone" $ do getCurrentTime >>= \t1 -> do z1 <- getCurrentTimeZone - let f1 = parse' z1 t1 + let f1 = fromUtc' z1 t1 traceIO $ show f1 1 `shouldBe` 1 it "- pico" $ do t1 <- getCurrentTime t2 <- getCurrentTime - let d1 = parse t1::DatePart Integer - d2 = parse t2::DatePart Integer + let d1 = fromUtc t1::DatePart Integer + d2 = fromUtc t2::DatePart Integer diff1 = t2 F.- t1 diff2 = pico d2 P.- (pico d1) diff1 `shouldBe` (Pico diff2) diff --git a/test/Test/TestSome.hs b/test/Test/TestSome.hs new file mode 100644 --- /dev/null +++ b/test/Test/TestSome.hs @@ -0,0 +1,31 @@ +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 + + +main::IO() +main = hspec $ do + describe "Test.TestCommon" $ do + it "iso" $ do + ts iso >>= utc + 1 `shouldBe` 1 + it "ymd" $ do + ts ymd >>= utc + 1 `shouldBe` 1 + it "tf" $ do + ts tf >>= utc + 1 `shouldBe` 1 + it "t" $ do + ts t >>= utc + 1 `shouldBe` 1 + it "dt" $ do + ts dt >>= utc + 1 `shouldBe` 1 + + +utc::Tz String -> IO() +utc = traceIO . show diff --git a/test/Test/TestTime.hs b/test/Test/TestTime.hs --- a/test/Test/TestTime.hs +++ b/test/Test/TestTime.hs @@ -3,22 +3,19 @@ import Test.Hspec import Debug.Trace -import Data.Time.Hora.Timestamp -import Prelude hiding ((<),(>)) +import Data.Time.Hora.Stamp +import Data.Time.Hora.Some main::IO() main = hspec $ do describe "Test.TestTime" $ do it "timestamp" $ do - t >>= traceIO + ts t >>= traceIO 1 `shouldBe` 1 it "timestamp'" $ do - tf >>= traceIO + ts tf >>= traceIO 1 `shouldBe` 1 it "datetimestamp" $ do - dt >>= traceIO - 1 `shouldBe` 1 - it "ymd_local" $ do - d >>= traceIO . show + ts dt >>= traceIO 1 `shouldBe` 1 diff --git a/test/Test/TestUtc.hs b/test/Test/TestUtc.hs new file mode 100644 --- /dev/null +++ b/test/Test/TestUtc.hs @@ -0,0 +1,28 @@ +module Test.TestUtc where + +import Test.Hspec +import Data.Time.Hora.Part +import Data.Time.Clock +import Data.Time.Hora.Type +import Data.Time.LocalTime +import Debug.Trace + + +main::IO() +main = hspec $ do + describe "Test.TestUtc" $ do + it "invalid date" $ do + toUtc (DatePart {year = 2010, month = 20, day = 1, hour = 0, minute = 1 ,second = 1, pico = 0}) + `shouldBe` Nothing + it "round trip" $ do + now1 <- getCurrentTime + let dp1 = fromUtc now1 + Just now2 = toUtc $ traceShow dp1 dp1 + now1 `shouldBe` now2 + it "round trip local" $ do + now1 <- getCurrentTime + z1 <- getCurrentTimeZone + 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 new file mode 100644 --- /dev/null +++ b/test/Test/TestZone.hs @@ -0,0 +1,26 @@ +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.Zone +import Data.Time.Hora.Stamp +import Data.Time.Hora.Type + +main::IO() +main = hspec $ do + describe "Test.TestZone" $ do + it "UTC to Chile" $ do + chile1 <- getTimeZoneSeriesFromOlsonFile "./test/TimeSeriesData/ChileContinental" + 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 + + +ttz::TimeZoneSeries -> UTCTime -> Tz (DatePart Int) +ttz = toTimeZone