hora 2.2.0 → 2.2.1
raw patch · 36 files changed
+357/−266 lines, 36 filesdep +splitmixdep ~basesetup-changedPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: splitmix
Dependency ranges changed: base
API changes (from Hackage documentation)
+ Data.Time.Hora.Part: toSmall :: Integral a => DatePart a -> DatePartSmall
+ Data.Time.Hora.Stamp: instance Data.Time.Hora.Stamp.Now (Data.Time.Hora.Type.Tz Data.Time.Hora.Internal.DatePartSmall.DatePartSmall)
+ Data.Time.Hora.Stamp: instance Data.Time.Hora.Stamp.Now Data.Time.Hora.Internal.DatePartSmall.DatePartSmall
- Data.Time.Hora.Zone: toTimeZone :: (TwoInt a b, Tz' tz) => tz -> (Tz (DatePart a)) -> (Maybe (Tz (DatePart b)))
+ Data.Time.Hora.Zone: toTimeZone :: (TwoInt a b, Tz' tz) => tz -> Tz (DatePart a) -> Maybe (Tz (DatePart b))
Files
- Setup.hs +0/−2
- changelog.md +7/−0
- hora.cabal +46/−22
- src/Data/Time/Hora/Format.hs +9/−9
- src/Data/Time/Hora/Future.hs +4/−2
- src/Data/Time/Hora/Internal/DatePartSmall.hs +22/−20
- src/Data/Time/Hora/Internal/FromIntegral.hs +7/−0
- src/Data/Time/Hora/Internal/Pad.hs +3/−3
- src/Data/Time/Hora/Internal/Span.hs +18/−21
- src/Data/Time/Hora/Part.hs +88/−64
- src/Data/Time/Hora/Span.hs +19/−12
- src/Data/Time/Hora/Stamp.hs +24/−19
- src/Data/Time/Hora/Type.hs +16/−14
- src/Data/Time/Hora/Zone.hs +3/−4
- test/Main.hs +14/−11
- test/Test/TestAncientDate.hs +2/−3
- test/Test/TestCheckOverflow.hs +2/−3
- test/Test/TestConvert.hs +5/−6
- test/Test/TestDatePart.hs +2/−3
- test/Test/TestDatePartSmall.hs +2/−2
- test/Test/TestDatePartSmallConvert.hs +5/−5
- test/Test/TestDatePartSmallDoc.hs +2/−2
- test/Test/TestDiffTime.hs +2/−4
- test/Test/TestDmyHm.hs +2/−3
- test/Test/TestFormat.hs +2/−2
- test/Test/TestFuture.hs +2/−3
- test/Test/TestPico.hs +2/−3
- test/Test/TestPico2.hs +2/−3
- test/Test/TestRoundtripPicoMilli.hs +2/−3
- test/Test/TestSome.hs +2/−3
- test/Test/TestStamp.hs +31/−0
- test/Test/TestStorageSize.hs +2/−3
- test/Test/TestTime.hs +2/−3
- test/Test/TestUTCTimeBin.hs +2/−3
- test/Test/TestUtc.hs +2/−3
- test/Test/TestZone.hs +2/−3
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
changelog.md view
@@ -1,3 +1,10 @@+##### 2.2.1+ fix failing test++ add toSmall conversion function++ add Now instances for DatePartSmall+ ##### 2.2.0 add DatePartSmall
hora.cabal view
@@ -1,5 +1,5 @@ name: hora-version: 2.2.0+version: 2.2.1 build-type: Simple cabal-version: >=1.10 @@ -10,6 +10,7 @@ category: System, Time license: PublicDomain license-file: PublicDomain+ extra-source-files: changelog.md, README.md, test/TimeSeriesData/ChileContinental, test/TimeSeriesData/ROC@@ -20,7 +21,21 @@ type: git location: https://github.com/ciez/hora.git +flag legacy_libc+ description: set this flag to True if you see this error message :+ cbits-unix/init.c:3:10: error:+ fatal error: sys/random.h: No such file or directory+ 3 | #include <sys/random.h>+ | ^~~~~~~~~ + how to set this flag to true:+ in cabal.project or cabal.project.local+ add this line (0 indent):+ constraints: hora +legacy_libc+ default: False+ manual: True++ library exposed-modules: Data.Time.Hora.Span@@ -33,16 +48,19 @@ Data.Time.Hora.Some other-modules:- Data.Time.Hora.Internal.Span Data.Time.Hora.Internal.DatePartSmall+ Data.Time.Hora.Internal.FromIntegral Data.Time.Hora.Internal.Pad+ Data.Time.Hora.Internal.Span+ ghc-options: -fwarn-unused-imports- + build-depends: base >=4.7 && <5.0, time, timezone-series, binary- ++ hs-source-dirs: src default-language: Haskell2010 default-extensions: FlexibleInstances@@ -63,7 +81,7 @@ test-suite spec- default-language:Haskell2010+ default-language: Haskell2010 type: exitcode-stdio-1.0 ghc-options: -fwarn-unused-imports hs-source-dirs: test, src@@ -87,36 +105,39 @@ other-modules: Data.Time.Hora.Format Data.Time.Hora.Future+ Data.Time.Hora.Internal.DatePartSmall+ Data.Time.Hora.Internal.FromIntegral+ Data.Time.Hora.Internal.Pad+ Data.Time.Hora.Internal.Span 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.TestAncientDate+ Test.TestCheckOverflow Test.TestConvert+ Test.TestDatePart+ Test.TestDatePartSmall+ Test.TestDatePartSmallConvert+ Test.TestDatePartSmallDoc Test.TestDiffTime- Test.TestFuture- Test.TestTime Test.TestDmyHm+ Test.TestFormat+ Test.TestFuture Test.TestPico Test.TestPico2- Test.TestDatePart- Test.TestUtc- Test.TestZone+ Test.TestRoundtripPicoMilli Test.TestSome- Test.TestFormat- Test.TestUTCTimeBin- Test.TestAncientDate- Test.TestDatePartSmall+ Test.TestStamp Test.TestStorageSize- Test.TestDatePartSmallConvert- Test.TestRoundtripPicoMilli- Test.TestDatePartSmallDoc- Data.Time.Hora.Internal.Span- Data.Time.Hora.Internal.DatePartSmall- Test.TestCheckOverflow- Data.Time.Hora.Internal.Pad- build-depends: base >= 4.8,+ Test.TestTime+ Test.TestUTCTimeBin+ Test.TestUtc+ Test.TestZone++ build-depends: base >=4.7 && <5.0, hspec >= 2.1.7, QuickCheck >= 2.8.1, time,@@ -124,3 +145,6 @@ timezone-olson, binary, bytestring++ if flag(legacy_libc)+ build-depends: splitmix <= 0.1.1.0
src/Data/Time/Hora/Format.hs view
@@ -1,10 +1,12 @@-module Data.Time.Hora.Format +-- | 'Format' enum+module Data.Time.Hora.Format (-- * type Format(..), -- * format format, format',- show') where+ show'+ ) where import Data.Maybe import Data.String@@ -23,14 +25,14 @@ -- | format as local time in specified timezone-format'::Tz' tz =>+format' :: Tz' tz => [Format] -> tz -> UTCTime -> Tz String format' lf0 tz0 utc0 = Tz tz1 $ withDefaultLocale (build lf0) zt1- where zt1 = utcToZonedTime tz1 utc0::ZonedTime+ where zt1 = utcToZonedTime tz1 utc0 :: ZonedTime tz1 = tz' tz0 utc0 -withDefaultLocale::FormatTime t =>+withDefaultLocale :: FormatTime t => String -- ^ format. see 'formatTime' -> t -> String@@ -79,11 +81,9 @@ | Wk_year_Mon -- ^ week of year start Monday -- {-| build format string from 'Format' -} class Build f where- build::f -> String+ build :: f -> String instance Build [Format] where@@ -156,7 +156,7 @@ >>> show' $ T.negate $ toSpan $ mkMin 14 53 -14:53 -}-show'::DatePartSmall -> String+show' :: DatePartSmall -> String show' dp0 | (Day d0) <- dp0 = format [Y_m_d] $ fromJust $ toUtc $ DatePartSmall d0 0 0
src/Data/Time/Hora/Future.hs view
@@ -1,7 +1,9 @@+-- | 'C.UTCTime' 'TimeSpan' from now+-- | 'PicoDiff' : difference between times module Data.Time.Hora.Future where import Data.Fixed-import Data.Time.Clock+import Data.Time.Clock as C import Data.Time.Hora.Span import Data.Time.Hora.Type import Prelude as P@@ -29,7 +31,7 @@ return TimeSpan for ease of conversion with "Data.Time.Hora.Span" -} class PicoDiff a where- (-)::a -> a -> TimeSpan Integer+ (-) :: a -> a -> TimeSpan Integer instance PicoDiff UTCTime where
src/Data/Time/Hora/Internal/DatePartSmall.hs view
@@ -1,10 +1,13 @@+{- | 'DatePartSmall' uses fixed-size storage -} module Data.Time.Hora.Internal.DatePartSmall where -import Data.Binary-import Data.Time.Hora.Internal.Span-import GHC.Generics import Prelude hiding (negate)+import GHC.Generics +import Data.Binary+import Data.Time.Hora.Internal.FromIntegral (fi)++ {- | 'DatePartSmall' uses fixed-size storage. Storage (as encoded with "Data.Binary".encode) varies with the constructor used, is noted as \".. bytes\" against each constructor. allows to operate with dates only ..@@ -17,9 +20,9 @@ max date is: 11759222-01-19. That's 19 Jan 11759222 - see "Data.Time.Hora.Part" for conversion between 'UTCTime' and 'DatePartSmall'+ see "Data.Time.Hora.Part" for conversion between 'Data.Time.Clock.UTCTime' and 'DatePartSmall' - only values constructed with 'DatePartSmall' can be converted to 'UTCTime'+ only values constructed with 'DatePartSmall' can be converted to 'Data.Time.Clock.UTCTime' -} data DatePartSmall = Day Word32 {- ^ days after 31 Dec 1 BC: 1 Jan AD 1 is day 1. See https://en.wikipedia.org/wiki/Anno_Domini @@ -65,7 +68,7 @@ 'Ms' -> 'Ms'' -}-toSpan::DatePartSmall -> DatePartSmall+toSpan :: DatePartSmall -> DatePartSmall toSpan dp0 = case dp0 of Day d1 -> Day' d1 Min m1 -> Min' m1@@ -74,7 +77,7 @@ {- | adds hidden Neg constructor to 'Day'', 'Min'' or 'Ms'' to enable negative spans -}-negate::DatePartSmall -> DatePartSmall+negate :: DatePartSmall -> DatePartSmall negate dp0 = case dp0 of Neg dp1 -> dp1 Day' d1 -> Neg dp0@@ -83,11 +86,12 @@ otherwise -> dp0 -- | checks if 'DatePartSmall' is a negative span-isNegative::DatePartSmall -> Bool+isNegative :: DatePartSmall -> Bool isNegative dp0 = case dp0 of (Neg _) -> True otherwise -> False +-- | error detail enum data ErrorDetail = Invalid -- ^ operation is not possible with these constructors | Overflow -- ^ data type maxed out | Invalid_Overflow -- ^ 'Invalid' <> 'Overflow'@@ -175,12 +179,12 @@ when incrementing and decrementing, overflow is checked on both upper (max for Word16, Word32) and lower (0) bounds -when incrementing, it is possible to normalize time by recalculating minutes from seconds, days from minutes. See 'normalize' in "Data.Time.Hora.Part"+when incrementing, it is possible to normalize time by recalculating minutes from seconds, days from minutes. See 'Data.Time.Hora.Part.normalize' in "Data.Time.Hora.Part" when decrementing, normalization is not yet implemented. todo -} -incrDecr::(Int -> Int -> Int) -- ^ op (+) (-)+incrDecr :: (Int -> Int -> Int) -- ^ op (+) (-) -> DatePartSmall -> DatePartSmall -> DatePartSmall@@ -235,9 +239,7 @@ | otherwise = Error Invalid ---checkOverflow::forall a b. (Bounded a, Integral a, Num a) =>+checkOverflow :: forall a b. (Bounded a, Integral a, Num a) => (a -> DatePartSmall) -- ^ ctor -> a -> (Int -> Int -> Int) -- ^ op (+) (-)@@ -248,10 +250,10 @@ && result1 <= max_aInt1 then ctor0 $ fi result1 else Error Overflow- where b1 = fi a1::Int- b2 = fi a2::Int- min_a1 = minBound::a- min_aInt1 = fi min_a1::Int- max_a1 = maxBound::a- max_aInt1 = fi max_a1::Int- result1 = op0 b1 b2::Int+ where b1 = fi a1 :: Int+ b2 = fi a2 :: Int+ min_a1 = minBound :: a+ min_aInt1 = fi min_a1 :: Int+ max_a1 = maxBound :: a+ max_aInt1 = fi max_a1 :: Int+ result1 = op0 b1 b2 :: Int
+ src/Data/Time/Hora/Internal/FromIntegral.hs view
@@ -0,0 +1,7 @@+module Data.Time.Hora.Internal.FromIntegral where++-- | constraint+type TwoInt a b = (Integral a, Integral b)++fi :: TwoInt a b => a -> b+fi = fromIntegral
src/Data/Time/Hora/Internal/Pad.hs view
@@ -10,7 +10,7 @@ "--abc" -} -pad::Char -> Int -> String -> String+pad :: Char -> Int -> String -> String pad c0 tot0 txt0 = p1 ++ txt0 where p1 = pad_ c0 tot0 txt0 @@ -20,10 +20,10 @@ >>> pad' '-' 5 "abc" "abc--" -}-pad'::Char -> Int -> String -> String+pad' :: Char -> Int -> String -> String pad' c0 tot0 txt0 = txt0 ++ p1 where p1 = pad_ c0 tot0 txt0 -pad_::Char -> Int -> String -> String+pad_ :: Char -> Int -> String -> String pad_ c0 tot0 txt0 = [const c0 p1 | p1 <- [1..(tot0 - (length txt0))]]
src/Data/Time/Hora/Internal/Span.hs view
@@ -1,5 +1,7 @@ module Data.Time.Hora.Internal.Span where +import Data.Time.Hora.Internal.FromIntegral as F (fi, TwoInt)+ {- | second and fractions see "Data.Time.Hora.Span" for conversion -}@@ -7,13 +9,8 @@ | Pico a | Milli a deriving (Show, Functor) --- | constraint-type TwoInt a b = (Integral a, Integral b) -fi::TwoInt a b => a -> b-fi = fromIntegral--withPico::Integral a => (a -> a -> a) ->+withPico :: Integral a => (a -> a -> a) -> TimeSpan a -> TimeSpan a -> TimeSpan a withPico fn0 a0 b0 = Pico $ fn0 a1 b1 where a1 = toPico a0@@ -22,38 +19,38 @@ {- | >>> 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+toPico :: TwoInt a b => TimeSpan a -> b+toPico (Pico i0) = fi i0+toPico (Milli i0) = fi $ i0 * picoMs+toPico (Sec i0) = fi $ 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+toMilli :: TwoInt a b => TimeSpan a -> b+toMilli (Pico i0) = fi $ i0 `div` picoMs+toMilli (Milli i0) = fi $ i0+toMilli (Sec i0) = fi $ 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+toSec :: TwoInt a b => TimeSpan a -> b+toSec (Pico i0) = fi $ i0 `div` picoSec+toSec (Milli i0) = fi $ i0 `div` msSec+toSec (Sec i0) = fi $ i0 -- | pico in 1 second-picoSec::Integral a => a+picoSec :: Integral a => a picoSec = 1000000000000 -- 12 -- | pico in 1 milli-picoMs::Integral a => a+picoMs :: Integral a => a picoMs = 1000000000 -- 9 -- | milli in 1 sec-msSec::Integral a => a+msSec :: Integral a => a msSec = 1000
src/Data/Time/Hora/Part.hs view
@@ -1,4 +1,4 @@--- | convert between 'UTCTime', 'UTCTimeBin', 'DatePart', 'DatePartSmall'+-- | convert between 'C.UTCTime', 'UTCTimeBin', 'DatePart', 'DatePartSmall' module Data.Time.Hora.Part (-- * FromUTC FromUTC(..),@@ -9,29 +9,36 @@ mkDay, mkMin, mkMs,+ toSmall, normalize, julian_day_offset ) where import Data.Fixed import Data.Ratio-import Data.Time.Calendar-import Data.Time.Clock-import Data.Time.Hora.Internal.Span+import Data.Word+import Data.Time.Calendar as C+import Data.Time.Clock as C++import Data.Time.Hora.Internal.DatePartSmall as S+import Data.Time.Hora.Internal.Span as S import Data.Time.Hora.Span-import Data.Time.Hora.Type+import Data.Time.Hora.Type as T import Data.Time.LocalTime as L-import Data.Word+import Data.Time.Hora.Internal.FromIntegral (fi) ++-- | convert 'C.UTCTime' to implemented types class FromUTC a where- fromUtc::UTCTime -> a+ fromUtc :: UTCTime -> a + -- | returns DatePart a in UTC timezone instance Integral a => FromUTC (DatePart a) where- fromUtc::Integral a => UTCTime -> DatePart a+ fromUtc :: Integral a => UTCTime -> DatePart a fromUtc t0 =- let day1 = utctDay t0::Day- dt1 = utctDayTime t0::DiffTime+ let day1 = utctDay t0 :: Day+ dt1 = utctDayTime t0 :: DiffTime (y1,m1,d1) = toGregorian day1 (tod1, sec5, pico5) = todSecPico dt1 in DatePart {@@ -45,16 +52,16 @@ } --- | extract (TimeIfDay, seconds, picoseconds) from 'DiffTime'-todSecPico::Integral a => DiffTime -> (TimeOfDay, a, Integer)+-- | extract ('TimeOfDay', seconds, picoseconds) from 'DiffTime'+todSecPico :: Integral a => DiffTime -> (TimeOfDay, a, Integer) todSecPico dt0 = (tod1, sec5, pico5)- where tod1 = timeToTimeOfDay dt0::TimeOfDay- pico4 = todSec tod1::Fixed E12+ where tod1 = timeToTimeOfDay dt0 :: TimeOfDay+ pico4 = todSec tod1 :: Fixed E12 (sec5, MkFixed pico5) = properFraction pico4 -diffTime::Int -- ^ hour- -> Int -- ^ minute+diffTime :: Int -- ^ hour+ -> Int -- ^ minute -> Fixed E12 -- ^ pico -> DiffTime diffTime h0 m0 p0 = timeOfDayToTime tod1@@ -62,23 +69,22 @@ instance FromUTC UTCTimeBin where- fromUtc::UTCTime -> UTCTimeBin+ fromUtc :: UTCTime -> UTCTimeBin fromUtc t0 = UTCTimeBin day1 pico1 where day1 = toModifiedJulianDay $ utctDay t0- pico1 = diffTimeToPicoseconds $ utctDayTime t0+ pico1 = diffTimeToPicoseconds $ utctDayTime t0 instance FromUTC DatePartSmall where- fromUtc::UTCTime -> DatePartSmall+ fromUtc :: UTCTime -> DatePartSmall fromUtc t0 = DatePartSmall day2 minute2 milli2- where dp1 = fromUtc t0::DatePart Int- UTCTimeBin julian1 _ = fromUtc t0::UTCTimeBin+ where dp1 = fromUtc t0 :: DatePart Int+ UTCTimeBin julian1 _ = fromUtc t0 :: UTCTimeBin day2 = fi julian1 + julian_day_offset minute2 = fi $ hour dp1 * 60 + minute dp1 milli2 = fromSec3 + fromPico3- fromSec3 = toMilli (Sec $ second dp1)::Word32- fromPico3 = toMilli $ Pico $ pico dp1::Word32-+ fromSec3 = toMilli (Sec $ second dp1) :: Word32+ fromPico3 = toMilli $ Pico $ pico dp1 :: Word32 @@ -87,7 +93,7 @@ Tz (DatePart a) parts show local date & time see also "Data.Time.Hora.Zone" -}-fromUtc'::(Tz' tz, Integral a) => +fromUtc' :: (Tz' tz, Integral a) => tz -> UTCTime -> Tz (DatePart a) fromUtc' tz0 utc0 = let tz1 = tz' tz0 utc0 @@ -104,16 +110,16 @@ second = fi sec5, pico = fi pico5 }- pico4 = todSec time2::Fixed E12+ pico4 = todSec time2 :: Fixed E12 (sec5, MkFixed pico5) = properFraction pico4 in Tz tz1 d4 -{-| convert 'DatePart' -> 'UTCTime'+{-| convert 'DatePart' -> 'C.UTCTime' Invalid date returns Nothing -} class ToUTC a where- toUtc::a -> Maybe UTCTime+ toUtc :: a -> Maybe UTCTime instance Integral a => ToUTC (DatePart a) where@@ -122,7 +128,7 @@ min1 = minute dp0 * 60 -- as second s2 = second dp0 + h1 + min1 diff1 = secondsToDiffTime $ fi s2- diff2 = picosecondsToDiffTime $ fi $ pico dp0 + diff2 = picosecondsToDiffTime $ fi $ pico dp0 mday1 = fromGregorianValid (fi $ year dp0) (fi $ month dp0) $ fi $ day dp0@@ -133,11 +139,16 @@ 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+ mtod1 = makeTimeOfDayValid (fi $ hour dp0)+ (fi $ minute dp0)+ (timeSpanPico $+ Pico s1 ++ (Pico $ fi $ pico dp0)+ )+ mday1 :: Maybe C.Day = fromGregorianValid+ (fi $ year dp0)+ (fi $ month dp0)+ (fi $ day dp0) in mday1 >>= \day1 -> mtod1 >>= \tod1 -> let lt1 = LocalTime day1 tod1@@ -155,16 +166,19 @@ toUtc dp0@(DatePartSmall _ _ _) = Just utc1 where (DatePartSmall d0 m0 ms0) = normalize dp0 utc1 = UTCTime day2 diff2- day1 = fi d0 - julian_day_offset::Integer+ day2 = ModifiedJulianDay day1+ where day1 = fi d0 - julian_day_offset :: Integer+ diff2 = diffTime hr1 min1 pico2- min1 = fi $ m0 `rem` 60- hr1 = fi $ m0 `div` 60- sec1 = fi $ ms0 `div` 1000- sec2 = MkFixed $ sec1 * picoSec::Fixed E12- ms1 = fi ms0::Integer- pico1 = fromRational $ (ms1 `rem` 1000) % 1000::Fixed E12- pico2 = sec2 + pico1+ where min1 = fi $ m0 `rem` 60+ hr1 = fi $ m0 `div` 60+ pico2 = sec2 + pico1+ where sec2 = MkFixed $ sec1 * picoSec :: Fixed E12+ pico1 = fromRational $ (ms1 `rem` 1000) % 1000 :: Fixed E12+ ms1 = fi ms0 :: Integer+ sec1 = fi $ ms0 `div` 1000+ toUtc _ = Nothing @@ -176,41 +190,52 @@ >>> mkDay 1858 11 17 `shouldBe` (Day julian_day_offset) -}-julian_day_offset::Integral a => a-julian_day_offset = fromIntegral 678576+julian_day_offset :: Integral a => a+julian_day_offset = fi 678576 +-- | convert 'DatePart' to 'DatePartSmall' with some loss of precision+toSmall :: Integral a =>+ DatePart a -> DatePartSmall+toSmall DatePart{..} =+ let S.Day d = mkDay year month day+ S.Min m = mkMin hour minute+ S.Ms ms = mkMs second $ toMilli $ Pico pico+ in DatePartSmall d m ms++ -- | day / date-mkDay::Integral a =>+mkDay :: Integral a => a -- ^ year -> a -- ^ month -> a -- ^ day- -> DatePartSmall -- ^ 'Day'+ -> DatePartSmall -- ^ 'T.Day' mkDay y0 m0 d0 = maybe (Error Invalid) id mday2- where mday2 = valid2 <$> mday1::Maybe DatePartSmall- mday1 = fromGregorianValid y1 m1 d1- valid2 = Day . fromIntegral . (+ julian_day_offset) . toModifiedJulianDay- y1 = fromIntegral y0- m1 = fromIntegral m0- d1 = fromIntegral d0+ where mday2 = valid2 <$> mday1 :: Maybe DatePartSmall+ mday1 :: Maybe C.Day = fromGregorianValid y1 m1 d1+ valid2 = T.Day . fi . (+ julian_day_offset) . toModifiedJulianDay+ y1 = fi y0+ m1 = fi m0+ d1 = fi d0 -- | minutes including hours-mkMin::(Num a, Integral a) =>+mkMin :: (Num a, Integral a) => a -- ^ hour -> a -- ^ minute -> DatePartSmall -- ^ 'Min'-mkMin h0 m0 = Min $ fromIntegral $ h0 * 60 + m0+mkMin h0 m0 = Min $ fi $ h0 * 60 + m0 -- | milliseconds including seconds-mkMs::(Num a, Integral a) =>+mkMs :: (Num a, Integral a) => a -- ^ second -> a -- ^ millisecond -> DatePartSmall -- ^ 'Ms'-mkMs s0 ms0 = Ms $ fromIntegral $ toMilli (Sec s0) + ms0+mkMs s0 ms0 = Ms $ fi $ toMilli (Sec s0) + ms0 + {- | for ('Time', 'DatePartSmall') increase: minutes if seconds > 60@@ -221,10 +246,10 @@ this function is called by 'toUtc' before the conversion -}-normalize::DatePartSmall -> DatePartSmall+normalize :: DatePartSmall -> DatePartSmall normalize dp0 | (Time m1 ms1) <- dp0,- ms2::Int <- fi ms1,+ ms2 :: Int <- fi ms1, sec1 <- ts ms2, sec1 >= 60 = let m3 = (sec1 `div` 60) + (fi m1::Int)@@ -233,7 +258,7 @@ in Time (fi m3) $ fi ms3 | (DatePartSmall d1 m1 ms1) <- dp0,- ms2::Int <- fi ms1,+ ms2 :: Int <- fi ms1, sec1 <- ts ms2, sec1 >= 60 = let Time m2 ms2 = normalize $ Time m1 ms1@@ -249,9 +274,8 @@ in DatePartSmall (fi d2) (fi m3) ms1 | otherwise = dp0--tm::Integral a => a -> a-tm = toMilli . Sec+ where ts :: Integral a => a -> a+ ts = toSec . Milli -ts::Integral a => a -> a-ts = toSec . Milli+ tm :: Integral a => a -> a+ tm = toMilli . Sec
src/Data/Time/Hora/Span.hs view
@@ -1,4 +1,5 @@-module Data.Time.Hora.Span +{- | Conversion between 'TimeSpan', 'DiffTime', 'NominalDiffTime', 'F.pico' -}+module Data.Time.Hora.Span (-- ** 'TimeSpan' toPico, toMilli,@@ -7,7 +8,7 @@ picoSec, picoMs, msSec,- -- ** 'Pico' - 'TimeSpan' conversion+ -- ** 'F.Pico' - 'TimeSpan' conversion picoTimeSpan, timeSpanPico, -- ** diff time@@ -15,28 +16,34 @@ nominalDiff ) where -import Data.Fixed+import Data.Fixed as F import Data.Ratio import Data.Time.Clock import Data.Time.Hora.Type-import Data.Time.Hora.Internal.Span+import Data.Time.Hora.Internal.Span as S+import Data.Time.Hora.Internal.FromIntegral (fi) -toDiffTime::Integral a => TimeSpan a -> DiffTime-toDiffTime (Sec s0) = secondsToDiffTime $ fromIntegral s0-toDiffTime (Pico s0) = picosecondsToDiffTime $ fromIntegral s0++-- | convert 'TimeSpan' to 'DiffTime'+toDiffTime :: Integral a => TimeSpan a -> DiffTime+toDiffTime (Sec s0) = secondsToDiffTime $ fi s0+toDiffTime (S.Pico s0) = picosecondsToDiffTime $ fi s0 toDiffTime t0@(Milli s0) = picosecondsToDiffTime $ toPico t0 -nominalDiff::Integral a => TimeSpan a -> NominalDiffTime+-- | convert 'TimeSpan' to 'NominalDiffTime'+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+-- | convert 'F.Pico' to 'TimeSpan'+picoTimeSpan :: Integral a => F.Pico -> TimeSpan a+picoTimeSpan (MkFixed p0) = S.Pico $ fi p0 -timeSpanPico::Integral a => TimeSpan a -> Pico -timeSpanPico ts0 = MkFixed $ fromIntegral p0+-- | convert 'TimeSpan' to 'F.Pico'+timeSpanPico :: Integral a => TimeSpan a -> F.Pico+timeSpanPico ts0 = MkFixed $ fi p0 where p0 = toPico ts0
src/Data/Time/Hora/Stamp.hs view
@@ -1,4 +1,5 @@-module Data.Time.Hora.Stamp +-- |+module Data.Time.Hora.Stamp (-- * numerical Now(..), -- * 'String'@@ -7,59 +8,63 @@ import Data.Time.Clock import Data.Time.Hora.Format-import Data.Time.Hora.Part+import Data.Time.Hora.Part as P import Data.Time.Hora.Type import Data.Time.LocalTime as L -- | numeric class Now a where- now::IO a+ now :: IO a instance Integral a => Now (DatePart a) where now = withUTCTime fromUtc {-^ UTC ->>> now::IO(DatePart Int)+>>> now :: IO (DatePart Int) DatePart {year = 2016, month = 12, day = 15, hour = 10, minute = 20, second = 31, pico = 494880242000} -} +instance Now DatePartSmall where+ now = withUTCTime fromUtc+{-^ UTC -} + instance Now UTCTime where now = getCurrentTime-{- ^ >>> now::IO UTCTime+{-^ >>> now :: IO UTCTime 2016-12-15 10:20:54.664155598 UTC -} instance Integral a => Now (Tz (DatePart a)) where now = withTimeZone fromUtc'-{- ^ local timezone +{-^ local timezone 'Tz' ('DatePart' a) parts show local date & time ->>> now::IO(Tz (DatePart Int))+>>> now :: IO(Tz (DatePart Int)) Tz CET (DatePart {year = 2016, month = 12, day = 15, hour = 11, minute = 21, second = 21, pico = 657029375000}) -} +instance Now (Tz DatePartSmall) where+ now = withTimeZone fromUtc' >>=+ \tsdp -> pure $ P.toSmall <$> tsdp+{-^ local timezone -} -withTimeZone::(TimeZone -> UTCTime -> Tz a) -> IO (Tz a)-withTimeZone fn0 = do- z1 <- getCurrentTimeZone -- CET | CEST- t1 <- getCurrentTime- pure $ fn0 z1 t1 +withTimeZone :: (TimeZone -> UTCTime -> Tz a) -> IO (Tz a)+withTimeZone fn0 = fn0 <$> getCurrentTimeZone <*> getCurrentTime -withUTCTime::(UTCTime -> a) -> IO a-withUTCTime fn0 = do- t1 <- getCurrentTime- pure $ fn0 t1 +withUTCTime :: (UTCTime -> a) -> IO a+withUTCTime fn0 = fn0 <$> getCurrentTime + {- | timestamp in specified format see "Data.Time.Hora.Some" for common ['Format']s -} class Timestamp out where- ts::[Format] -> IO out+ ts :: [Format] -> IO out instance Timestamp String where@@ -71,6 +76,6 @@ -- ^ local timezone --- | timestamp in specified format, 'TimeZone' | 'TimeZoneSeries'-ts'::Tz' tz => [Format] -> tz -> IO (Tz String)+-- | timestamp in specified format, 'L.TimeZone' | 'Data.Time.LocalTime.TimeZone.Series.TimeZoneSeries'+ts' :: Tz' tz => [Format] -> tz -> IO (Tz String) ts' lf0 tz0 = withUTCTime $ format' lf0 tz0
src/Data/Time/Hora/Type.hs view
@@ -1,4 +1,5 @@-module Data.Time.Hora.Type +{- | 'DatePart', 'DatePartSmall', 'UTCTimeBin', 'Tz', 'TimeSpan' -}+module Data.Time.Hora.Type (-- * DatePart DatePart(..), -- * DatePartSmall@@ -14,23 +15,24 @@ Tz'(..), -- * TimeSpan TimeSpan(..),- TwoInt(..)) where+ TwoInt) where import Data.Binary-import Data.Time.Clock+import Data.Time.Clock as C import Data.Time.Hora.Internal.DatePartSmall+import Data.Time.Hora.Internal.FromIntegral import Data.Time.Hora.Internal.Span-import Data.Time.LocalTime-import Data.Time.LocalTime.TimeZone.Series+import Data.Time.LocalTime as L+import Data.Time.LocalTime.TimeZone.Series as S import GHC.Generics import Prelude hiding (negate) {- | serializeable structure for essential Date, Time parts -may also be used to construct 'UTCTime' +may also be used to construct 'C.UTCTime' -see "Data.Time.Hora.Part" for conversion between 'UTCTime' and 'DatePart' -}+see "Data.Time.Hora.Part" for conversion between 'C.UTCTime' and 'DatePart' -} data DatePart a = DatePart { year::a, month::a,@@ -90,11 +92,11 @@ -- private data Ord_ = Stop Bool | Continue -{- | 'UTCTimeBin' closely mimicks 'UTCTime' without loss of precision+{- | 'UTCTimeBin' closely mimicks 'C.UTCTime' without loss of precision -'UTCTimeBin' has 'Binary' instance. The only purpose of 'UTCTimeBin' is to offer faster conversion from / to 'UTCTime' and more compact serialization compared with 'DatePart'.+'UTCTimeBin' has 'Binary' instance. The only purpose of 'UTCTimeBin' is to offer faster conversion from / to 'C.UTCTime' and more compact serialization compared with 'DatePart'. -see "Data.Time.Hora.Part" for conversion between 'UTCTime' and 'UTCTimeBin' -}+see "Data.Time.Hora.Part" for conversion between 'C.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@@ -114,18 +116,18 @@ deriving instance Ord a => Ord (Tz a) --- | 'TimeZone' | 'TimeZoneSeries'+-- | 'L.TimeZone' | 'S.TimeZoneSeries' class Tz' tz where- tz'::tz -> UTCTime -> TimeZone+ tz' :: tz -> C.UTCTime -> TimeZone instance Tz' TimeZone where tz' tz0 _ = tz0 instance Tz' TimeZoneSeries where tz' = timeZoneFromSeries-{- ^ see "Data.Time.Hora.Zone" re: 'TimeZoneSeries'+{- ^ see "Data.Time.Hora.Zone" re: 'S.TimeZoneSeries' -use of 'TimeZoneSeries' is preferred when converting from 'UTCTime' to 'DatePart' -}+use of 'S.TimeZoneSeries' is preferred when converting from 'C.UTCTime' to 'DatePart' -}
src/Data/Time/Hora/Zone.hs view
@@ -11,7 +11,7 @@ -- see man tzfile for common olson file locations getTimeZoneSeriesFromOlsonFile "\/usr\/share\/zoneinfo\/Chile\/Continental" >>=- \\(chile1::TimeZoneSeries) -> ... + \\(chile1 :: TimeZoneSeries) -> ... @ -} module Data.Time.Hora.Zone where @@ -19,12 +19,11 @@ import Data.Time.Hora.Type --- ^ convert 'DatePart' from one 'TimeZone' to another +-- ^ convert 'DatePart' from one 'Data.Time.LocalTime.TimeZone' to another toTimeZone::(TwoInt a b, Tz' tz) => tz -- ^ target timezone -> (Tz (DatePart a)) -- ^ local (to source timezone) date & time -> (Maybe (Tz (DatePart b))) {- ^ local (to target timezone) date & time 'Nothing' if source date is invalid-} -toTimeZone series0 dp0 = toUtc dp0 >>= Just . (fromUtc' series0)- +toTimeZone series0 dp0 = fromUtc' series0 <$> toUtc dp0
test/Main.hs view
@@ -1,28 +1,30 @@ module Main where +import Test.Hspec+import qualified Test.TestAncientDate as A+import qualified Test.TestCheckOverflow as Of import qualified Test.TestConvert as Conv+import qualified Test.TestDatePart as Dp+import qualified Test.TestDatePartSmall as Sm+import qualified Test.TestDatePartSmallConvert as Smc+import qualified Test.TestDatePartSmallDoc as Smd 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.TestFormat as Tf import qualified Test.TestFuture as Fut import qualified Test.TestPico as P import qualified Test.TestPico2 as P2+import qualified Test.TestRoundtripPicoMilli as Pm import qualified Test.TestSome as Tcom-import qualified Test.TestFormat as Tf+import qualified Test.TestStamp as Stamp+import qualified Test.TestStorageSize as Sto import qualified Test.TestTime as Tt import qualified Test.TestUTCTimeBin as Bin+import qualified Test.TestUtc as U import qualified Test.TestZone as Z-import qualified Test.TestAncientDate as A-import qualified Test.TestDatePartSmall as Sm-import qualified Test.TestStorageSize as Sto-import qualified Test.TestDatePartSmallConvert as Smc-import qualified Test.TestRoundtripPicoMilli as Pm-import qualified Test.TestDatePartSmallDoc as Smd-import qualified Test.TestCheckOverflow as Of main::IO()-main = do+main = hspec $ do Of.main T.main Conv.main@@ -43,3 +45,4 @@ Smc.main Pm.main Smd.main+ Stamp.main
test/Test/TestAncientDate.hs view
@@ -6,9 +6,8 @@ import Debug.Trace import Test.Hspec -main::IO()-main = hspec $ do- describe "day way in the past" $ do+main :: SpecWith ()+main = describe "day way in the past" $ do it "year 1" $ do traceIO $ "year 1: " <> (show utc1) traceIO $ "year 1: " <> (show utcbin1)
test/Test/TestCheckOverflow.hs view
@@ -5,9 +5,8 @@ import Test.Hspec -main::IO()-main = hspec $ do- describe "TestCheckOverflow" $ do+main :: SpecWith()+main = describe "TestCheckOverflow" $ do it "addition succeeds" $ do let result1 = checkOverflow Min' 3 (+) 10 result1 `shouldBe` (Min' 13)
test/Test/TestConvert.hs view
@@ -6,15 +6,15 @@ import Test.Hspec -main::IO()+main:: SpecWith () main = do test doc -test::IO()-test = hspec $ do+test:: SpecWith ()+test = do describe "Case.Convert" $ do it "pico 1" $ do toPico (Sec $ i 12) `shouldBe` (toPico $ Milli $ toMilli $ Sec $ i 12)@@ -38,9 +38,8 @@ s1 = toSec (Milli m1)::Int i3 = 3::Int -doc::IO()-doc = hspec $ do- describe "doc Convert" $ do+doc:: SpecWith ()+doc = describe "doc Convert" $ do it "toPicos milli" $ toPico (Milli 1) `shouldBe` 1000000000 it "toPicos sec" $ toPico (Sec 1) `shouldBe` 1000000000000 it "toMillis sec" $ toMilli (Sec 1) `shouldBe` 1000
test/Test/TestDatePart.hs view
@@ -7,9 +7,8 @@ default (Int) -main::IO()-main = hspec $ do- describe "Test.TestDatePart" $ do+main:: SpecWith ()+main = describe "Test.TestDatePart" $ do it "Ord" $ do (dp 1 1 1 1 1 1 1) `shouldSatisfy` (== (dp 1 1 1 1 1 1 1)) (dp 1 1 1 1 1 1 1) `shouldSatisfy` (<= (dp 1 1 1 1 1 1 1))
test/Test/TestDatePartSmall.hs view
@@ -6,8 +6,8 @@ import Test.Hspec -main::IO()-main = hspec $ do+main:: SpecWith ()+main = do describe "TestDatePartSmall merge" $ do it "1 Day <> Time" $ do Day 2 <> Time 3 5 `shouldBe` DatePartSmall 2 3 5
test/Test/TestDatePartSmallConvert.hs view
@@ -12,9 +12,8 @@ import Prelude as P import Test.Hspec -main::IO()-main = hspec $ do- describe "TestDatePartSmallConvert" $ do+main:: SpecWith ()+main = describe "TestDatePartSmallConvert" $ do it "now <-> DatePartSmall" $ do now1 <- now::IO UTCTime let small1 = fromUtc now1::DatePartSmall@@ -36,5 +35,6 @@ dp2 = fromUtc utcNow2::DatePart Int dp3 = fromUtc utcIncr3::DatePart Int traceIO $ "increment DatePartSmall by 1 day in minutes dp2: " <> show dp2- traceIO $ "increment DatePartSmall by 1 day in minutes dp3: " <>show dp3- day dp3 P.- day dp2 `shouldBe` 1+ traceIO $ "increment DatePartSmall by 1 day in minutes dp3: " <> show dp3+ if month dp3 /= month dp2 then day dp3 `shouldBe` 1+ else day dp3 P.- day dp2 `shouldBe` 1
test/Test/TestDatePartSmallDoc.hs view
@@ -12,8 +12,8 @@ import Test.Hspec -main::IO()-main = hspec $ do+main:: SpecWith ()+main = do describe "TestDatePartSmall" $ do it "day 1" $ do mkDay 1 1 1 `shouldBe` (Day 1)
test/Test/TestDiffTime.hs view
@@ -9,10 +9,8 @@ import Test.Hspec --main::IO()-main = hspec $ do- describe "TestDiffTime" $ do+main :: SpecWith ()+main = describe "TestDiffTime" $ do it "diff time" $ do t1 <- getCurrentTime threadDelay 7000
test/Test/TestDmyHm.hs view
@@ -4,9 +4,8 @@ import Test.Hspec -main::IO()-main = hspec $ do- describe "Test.TestDmyHm" $ do+main :: SpecWith ()+main = describe "Test.TestDmyHm" $ do it "case 1" $ do a1 `shouldSatisfy` (< b1) where a1 = DatePart {
test/Test/TestFormat.hs view
@@ -8,8 +8,8 @@ import Test.Hspec -main::IO()-main = hspec $ do+main::SpecWith ()+main = do describe "Test.TestFormat" $ do it "prefix tab \n Offset" $ do ts ["prefix", Tab, "postfix", Crlf, Offset] >>= utc
test/Test/TestFuture.hs view
@@ -7,9 +7,8 @@ import Test.Hspec -main::IO()-main = hspec $ do- describe "Case.TestFuture" $ do+main:: SpecWith ()+main = describe "Case.TestFuture" $ do it "3 second from now" $ do t1 <- getCurrentTime traceIO $ show t1
test/Test/TestPico.hs view
@@ -11,9 +11,8 @@ import Test.Hspec -main::IO()-main = hspec $ do- describe "Test.TestPico" $ do+main:: SpecWith ()+main = describe "Test.TestPico" $ do it "now" $ do (now::IO (DatePart Int)) >>= traceIO . show 1 `shouldBe` 1
test/Test/TestPico2.hs view
@@ -5,9 +5,8 @@ import Test.Hspec -main::IO()-main = hspec $ do- describe "Test.TestPico2" $ do+main:: SpecWith ()+main = describe "Test.TestPico2" $ do it "case 1" $ do traceIO $ show p1 let MkFixed p2 = p1
test/Test/TestRoundtripPicoMilli.hs view
@@ -10,9 +10,8 @@ import Test.Hspec -main::IO()-main = hspec $ do- describe "TestRoundtripPicoMilli" $ do+main:: SpecWith ()+main = describe "TestRoundtripPicoMilli" $ do it "round trip pico" $ do now1 <- now::IO UTCTime let dp1 = fromUtc now1::DatePart Int
test/Test/TestSome.hs view
@@ -7,9 +7,8 @@ import Test.Hspec -main::IO()-main = hspec $ do- describe "Test.TestCommon" $ do+main:: SpecWith ()+main = describe "Test.TestCommon" $ do it "iso" $ do ts iso >>= utc 1 `shouldBe` 1
+ test/Test/TestStamp.hs view
@@ -0,0 +1,31 @@+module Test.TestStamp where++import Debug.Trace+import Test.Hspec+import Data.Time.Clock+import Data.Time.Hora.Part+import Data.Time.Hora.Stamp+import Data.Time.Hora.Type+++main:: SpecWith ()+main = describe "Test.TestStamp" $ do+ it "now : UTC Time" $ do+ result1 :: UTCTime <- now+ traceIO $ show ("UTCTime",result1)+ it "now : DatePart Int" $ do+ result1 :: DatePart Int <- now+ traceIO $ show ("DatePart",result1)+ it "now : Tz (DatePart Int)" $ do+ result1 :: Tz (DatePart Int) <- now+ traceIO $ show ("Tz DatePart",result1)+ it "now : DatePartSmall" $ do+ result1 :: DatePartSmall <- now+ traceIO $ show ("DatePartSmall",result1)+ let utc2 = toUtc result1+ traceIO $ show ("DatePartSmall -> UTCTime",utc2)+ it "now : Tz DatePartSmall" $ do+ result1 :: Tz DatePartSmall <- now+ let utc2 = toUtc <$> result1+ traceIO $ show ("Tz DatePartSmall -> Tz UTCTime", utc2)+
test/Test/TestStorageSize.hs view
@@ -13,9 +13,8 @@ import Test.Hspec -main::IO()-main = hspec $ do- describe "compare binary size" $ do+main:: SpecWith ()+main = describe "compare binary size" $ do it "Min 10" $ do let result1 = Min 10 bin2 = encode result1
test/Test/TestTime.hs view
@@ -7,9 +7,8 @@ import Test.Hspec -main::IO()-main = hspec $ do- describe "Test.TestTime" $ do+main:: SpecWith ()+main = describe "Test.TestTime" $ do it "timestamp" $ do ts t >>= traceIO 1 `shouldBe` 1
test/Test/TestUTCTimeBin.hs view
@@ -11,9 +11,8 @@ import Test.Hspec -main::IO()-main = hspec $ do- describe "round trip convert & serialize UTCTime via UTCTimeBin" $ do+main:: SpecWith ()+main = describe "round trip convert & serialize UTCTime via UTCTimeBin" $ do it "round trip convert" $ do utc1 <- now::IO UTCTime let utcbin2 = fromUtc utc1::UTCTimeBin
test/Test/TestUtc.hs view
@@ -8,9 +8,8 @@ import Debug.Trace -main::IO()-main = hspec $ do- describe "Test.TestUtc" $ do+main:: SpecWith ()+main = 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
test/Test/TestZone.hs view
@@ -11,9 +11,8 @@ import Test.Hspec -main::IO()-main = hspec $ do- describe "Test.TestZone" $ do+main:: SpecWith ()+main = describe "Test.TestZone" $ do it "UTC to Chile" $ do chile1 <- getTimeZoneSeriesFromOlsonFile "./test/TimeSeriesData/ChileContinental" china1 <- getTimeZoneSeriesFromOlsonFile "./test/TimeSeriesData/ROC"