hora 2.1.0 → 2.2.0
raw patch · 19 files changed
+1013/−95 lines, 19 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Data.Time.Hora.Type: instance (GHC.Classes.Eq a, GHC.Real.Integral a) => GHC.Classes.Eq (Data.Time.Hora.Type.TimeSpan a)
- Data.Time.Hora.Type: instance (GHC.Classes.Ord a, GHC.Real.Integral a) => GHC.Classes.Ord (Data.Time.Hora.Type.TimeSpan a)
- Data.Time.Hora.Type: instance GHC.Base.Functor Data.Time.Hora.Type.TimeSpan
- Data.Time.Hora.Type: instance GHC.Real.Integral a => GHC.Num.Num (Data.Time.Hora.Type.TimeSpan a)
- Data.Time.Hora.Type: instance GHC.Show.Show a => GHC.Show.Show (Data.Time.Hora.Type.TimeSpan a)
+ Data.Time.Hora.Format: show' :: DatePartSmall -> String
+ Data.Time.Hora.Part: instance Data.Time.Hora.Part.FromUTC Data.Time.Hora.Internal.DatePartSmall.DatePartSmall
+ Data.Time.Hora.Part: instance Data.Time.Hora.Part.ToUTC Data.Time.Hora.Internal.DatePartSmall.DatePartSmall
+ Data.Time.Hora.Part: julian_day_offset :: Integral a => a
+ Data.Time.Hora.Part: mkDay :: Integral a => a -> a -> a -> DatePartSmall
+ Data.Time.Hora.Part: mkMin :: (Num a, Integral a) => a -> a -> DatePartSmall
+ Data.Time.Hora.Part: mkMs :: (Num a, Integral a) => a -> a -> DatePartSmall
+ Data.Time.Hora.Part: normalize :: DatePartSmall -> DatePartSmall
+ Data.Time.Hora.Type: DatePartSmall :: Word32 -> Word16 -> Word32 -> DatePartSmall
+ Data.Time.Hora.Type: Day :: Word32 -> DatePartSmall
+ Data.Time.Hora.Type: Day' :: Word32 -> DatePartSmall
+ Data.Time.Hora.Type: Error :: ErrorDetail -> DatePartSmall
+ Data.Time.Hora.Type: Invalid :: ErrorDetail
+ Data.Time.Hora.Type: Invalid_Overflow :: ErrorDetail
+ Data.Time.Hora.Type: Min :: Word16 -> DatePartSmall
+ Data.Time.Hora.Type: Min' :: Word16 -> DatePartSmall
+ Data.Time.Hora.Type: Ms :: Word32 -> DatePartSmall
+ Data.Time.Hora.Type: Ms' :: Word32 -> DatePartSmall
+ Data.Time.Hora.Type: Overflow :: ErrorDetail
+ Data.Time.Hora.Type: Time :: Word16 -> Word32 -> DatePartSmall
+ Data.Time.Hora.Type: data DatePartSmall
+ Data.Time.Hora.Type: data ErrorDetail
+ Data.Time.Hora.Type: instance (GHC.Classes.Eq a, GHC.Real.Integral a) => GHC.Classes.Eq (Data.Time.Hora.Internal.Span.TimeSpan a)
+ Data.Time.Hora.Type: instance (GHC.Classes.Ord a, GHC.Real.Integral a) => GHC.Classes.Ord (Data.Time.Hora.Internal.Span.TimeSpan a)
+ Data.Time.Hora.Type: instance GHC.Real.Integral a => GHC.Num.Num (Data.Time.Hora.Internal.Span.TimeSpan a)
+ Data.Time.Hora.Type: isNegative :: DatePartSmall -> Bool
+ Data.Time.Hora.Type: negate :: DatePartSmall -> DatePartSmall
+ Data.Time.Hora.Type: toSpan :: DatePartSmall -> DatePartSmall
Files
- changelog.md +3/−1
- hora.cabal +16/−2
- src/Data/Time/Hora/Format.hs +71/−2
- src/Data/Time/Hora/Internal/DatePartSmall.hs +257/−0
- src/Data/Time/Hora/Internal/Pad.hs +29/−0
- src/Data/Time/Hora/Internal/Span.hs +59/−0
- src/Data/Time/Hora/Part.hs +153/−12
- src/Data/Time/Hora/Span.hs +2/−36
- src/Data/Time/Hora/Type.hs +13/−38
- test/Main.hs +14/−1
- test/Test/TestAncientDate.hs +31/−0
- test/Test/TestCheckOverflow.hs +20/−0
- test/Test/TestDatePartSmall.hs +118/−0
- test/Test/TestDatePartSmallConvert.hs +40/−0
- test/Test/TestDatePartSmallDoc.hs +47/−0
- test/Test/TestFormat.hs +34/−1
- test/Test/TestRoundtripPicoMilli.hs +32/−0
- test/Test/TestStorageSize.hs +71/−0
- test/Test/TestUTCTimeBin.hs +3/−2
changelog.md view
@@ -1,3 +1,6 @@+##### 2.2.0+ add DatePartSmall+ ##### 2.1.0 add serializeable UTCTimeBin: close copy of UTCTime. @@ -5,7 +8,6 @@ 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
hora.cabal view
@@ -1,5 +1,5 @@ name: hora-version: 2.1.0+version: 2.2.0 build-type: Simple cabal-version: >=1.10 @@ -32,7 +32,11 @@ Data.Time.Hora.Zone Data.Time.Hora.Some - ghc-options: -fwarn-unused-imports + other-modules:+ Data.Time.Hora.Internal.Span+ Data.Time.Hora.Internal.DatePartSmall+ Data.Time.Hora.Internal.Pad+ ghc-options: -fwarn-unused-imports build-depends: base >=4.7 && <5.0, time,@@ -102,6 +106,16 @@ Test.TestSome Test.TestFormat Test.TestUTCTimeBin+ Test.TestAncientDate+ Test.TestDatePartSmall+ 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, hspec >= 2.1.7, QuickCheck >= 2.8.1,
src/Data/Time/Hora/Format.hs view
@@ -3,13 +3,18 @@ Format(..), -- * format format,- format') where+ format',+ show') where +import Data.Maybe import Data.String import Data.Time.Clock import Data.Time.Format (formatTime,defaultTimeLocale,FormatTime(..))-import Data.Time.Hora.Type+import Data.Time.Hora.Type hiding (Min) import Data.Time.LocalTime as L+import Data.Time.Hora.Part+import qualified Data.Time.Hora.Internal.DatePartSmall as S+import Data.Time.Hora.Internal.Pad -- | format as UTC@@ -114,3 +119,67 @@ D_week -> "%A" Wk_year_Sun -> "%U" Wk_year_Mon -> "%W"++++{- | pretty print 'DatePartSmall'++incremental values are prefixed with + or -++>>> show' $ mkDay 2018 08 17+ 2018-08-17++>>> show' $ mkMin 4 3+ 04:03++>>> show' $ mkMs 7 318+ 07.318++>>> let (Day d1) = mkDay 2018 08 17+ (Min m1) = mkMin 15 17+ (Ms ms1) = mkMs 7 358+ show' $ DatePartSmall d1 m1 ms1+ 2018-08-17 15:17:07.358++>>> show' $ Day' 3+ +3++>>> show' $ toSpan $ mkMin 0 53+ +00:53++>>> show' $ toSpan $ mkMs 7 0+ +07.000++>>> show' $ T.negate $ Day' 3+ -3++>>> show' $ T.negate $ toSpan $ mkMin 14 53+ -14:53+-}+show'::DatePartSmall -> String+show' dp0+ | (Day d0) <- dp0+ = format [Y_m_d] $ fromJust $ toUtc $ DatePartSmall d0 0 0+ | (Day' d0) <- dp0+ = "+" <> (show d0)+ | (S.Min m0) <- dp0+ = let hr1 = m0 `div` 60+ min1 = m0 `rem` 60+ in pad1 (show hr1) <> ":" <> pad1 (show min1)+ | (S.Min' m0) <- dp0+ = "+" <> (show' $ S.Min m0)+ | (S.Ms ms0) <- dp0+ = let sec1 = ms0 `div` 1000+ ms1 = ms0 `rem` 1000+ in pad1 (show sec1) <> "." <> (pad '0' 3 $ show ms1)+ | (S.Ms' ms0) <- dp0+ = "+" <> (show' $ S.Ms ms0)+ | (S.Time m0 ms0) <- dp0+ = show' (S.Min m0) <> ":" <> show' (S.Ms ms0)+ | (S.DatePartSmall d0 m0 ms0) <- dp0+ = show' (S.Day d0) <> " " <> show' (S.Min m0) <> ":" <> show' (S.Ms ms0)+ | (S.Neg dp0) <- dp0+ = let _:s1 = show' dp0+ in "-" <> s1+ | otherwise = show dp0+ where pad1 = pad '0' 2
+ src/Data/Time/Hora/Internal/DatePartSmall.hs view
@@ -0,0 +1,257 @@+module Data.Time.Hora.Internal.DatePartSmall where++import Data.Binary+import Data.Time.Hora.Internal.Span+import GHC.Generics+import Prelude hiding (negate)++{- | '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 ..++ .. or time (minute / millisecond precision) only++ is convenient for dealing with intervals / timespans++ day count begins at 1 Jan 0001: 1 Jan 0001 is day 1++ max date is: 11759222-01-19. That's 19 Jan 11759222++ see "Data.Time.Hora.Part" for conversion between 'UTCTime' and 'DatePartSmall'++ only values constructed with 'DatePartSmall' can be converted to '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++ 5 bytes -}+ | Min Word16 {- ^ minutes (includes hours)++ 3 bytes+ -}+ | Ms Word32 {- ^ milliseconds (includes seconds)++5 bytes+ -}+ | Time Word16 Word32 {- ^ minutes, milliseconds++ 7 bytes+ -}+ | DatePartSmall Word32 Word16 Word32 {- ^ date, minutes, milliseconds++ 11 bytes+ -}+ | Day' Word32 {- ^ date span in days++ 5 bytes+ -}+ | Min' Word16 {- ^ time span in minutes++ 3 bytes+ -}+ | Ms' Word32 {- ^ time span in milliseconds++ 5 bytes+ -}+ | Neg DatePartSmall -- ^ negate. Hidden constructor+ | Error ErrorDetail -- ^ result of failed operation+ deriving (Eq, Show, Generic)+++{- | substitutes constructor:++ 'Day' -> 'Day''++ 'Min' -> 'Min''++ 'Ms' -> 'Ms''+-}+toSpan::DatePartSmall -> DatePartSmall+toSpan dp0 = case dp0 of+ Day d1 -> Day' d1+ Min m1 -> Min' m1+ Ms ms1 -> Ms' ms1+ otherwise -> dp0++{- | adds hidden Neg constructor to 'Day'', 'Min'' or 'Ms''+to enable negative spans -}+negate::DatePartSmall -> DatePartSmall+negate dp0 = case dp0 of+ Neg dp1 -> dp1+ Day' d1 -> Neg dp0+ Min' m1 -> Neg dp0+ Ms' ms1 -> Neg dp0+ otherwise -> dp0++-- | checks if 'DatePartSmall' is a negative span+isNegative::DatePartSmall -> Bool+isNegative dp0 = case dp0 of+ (Neg _) -> True+ otherwise -> False++data ErrorDetail = Invalid -- ^ operation is not possible with these constructors+ | Overflow -- ^ data type maxed out+ | Invalid_Overflow -- ^ 'Invalid' <> 'Overflow'+ deriving (Eq, Show, Generic)++instance Binary ErrorDetail+instance Binary DatePartSmall++instance Semigroup DatePartSmall where+-- combine / merge+ (<>) (Day d0) (Time m0 ms0) = DatePartSmall d0 m0 ms0 -- 1+ (<>) (Min m0) (Ms ms0) = Time m0 ms0 -- 2++-- increment+ (<>) d1@(DatePartSmall _ _ _) d2@(Day' _) = incrDecr (+) d1 d2 -- 3+ (<>) d1@(DatePartSmall d0 m0 ms0) d2@(Min' m1) = incrDecr (+) d1 d2 -- 4+ (<>) d1@(DatePartSmall d0 m0 ms0) d2@(Ms' ms1) = incrDecr (+) d1 d2 -- 5+ (<>) d1@(Time m0 ms0) d2@(Min' m1) = incrDecr (+) d1 d2 -- 6+ (<>) d1@(Time m0 ms0) d2@(Ms' ms1) = incrDecr (+) d1 d2 -- 7++ (<>) d1@(Day m0) d2@(Day' m1) = incrDecr (+) d1 d2 -- 8+ (<>) d1@(Min m0) d2@(Min' m1) = incrDecr (+) d1 d2 -- 9+ (<>) d1@(Ms m0) d2@(Ms' m1) = incrDecr (+) d1 d2 -- 10++ (<>) d1@(Day' m0) d2@(Day' m1) = incrDecr (+) d1 d2 -- 8+ (<>) d1@(Min' m0) d2@(Min' m1) = incrDecr (+) d1 d2 -- 9+ (<>) d1@(Ms' m0) d2@(Ms' m1) = incrDecr (+) d1 d2 -- 10++-- decrement+ (<>) (Neg d1) (Neg d2) = negate $ incrDecr (+) d1 d2+ (<>) d1 (Neg d2) = incrDecr (-) d1 d2++-- overwrite+ (<>) (DatePartSmall _ _ _) (DatePartSmall d1 m1 ms1) = DatePartSmall d1 m1 ms1 -- 11+ (<>) (Time _ _) (Time m1 ms1) = Time m1 ms1 -- 12+ (<>) (Day _) (Day d1) = Day d1 -- 13+ (<>) (Min _) (Min m1) = Min m1 -- 14+ (<>) (Ms _) (Ms ms1) = Ms ms1 -- 15+-- update+ (<>) (DatePartSmall d0 _ _) (Time m1 ms1) = DatePartSmall d0 m1 ms1 -- 16+ (<>) (Time _ ms0) (Min m1) = Time m1 ms0 -- 17+ (<>) (Time m0 _) (Ms ms1) = Time m0 ms1 -- 18+-- errors+ (<>) (Error Invalid) (Error Invalid) = Error Invalid -- 19+ (<>) (Error Invalid) (Error Overflow) = Error Invalid_Overflow -- 20+ (<>) (Error Overflow) (Error Overflow) = Error Overflow -- 21+ (<>) (Error Overflow) (Error Invalid) = Error Invalid_Overflow -- 22+ (<>) (Error Invalid_Overflow) _ = Error Invalid_Overflow -- 23+ (<>) _ (Error Invalid_Overflow) = Error Invalid_Overflow -- 24+ (<>) e0@(Error _) _ = e0 -- 25+ (<>) _ e0@(Error _) = e0 -- 26+ (<>) _ _ = Error Invalid -- 27++{- ^ '<>' can be used both to combine parts (e.g. 'Day', 'Time') and+ to add date/time span to the existing parts++ combining parts:++ 'Day' <> 'Time' -> 'DatePartSmall'++>>> show' (mkDay 2018 08 20 <> mkMin 10 2 <> mkMs 30 9)+2018-08-20 10:02:30.009++ 'Min' <> 'Ms' -> 'Time'++ adding span:++ 'Day' <> 'Day'' -> 'Day'++>>> show' (mkDay 2018 1 1 <> Day' 20)+2018-01-21++>>> show' (mkDay 2018 1 1 <> Day' 180)+2018-06-30++ 'Min' <> 'Min'' -> 'Min'++>>> show' (mkMin 3 15 <> Min' 200)+06:35++ 'Ms' <> 'Ms'' -> 'Ms'++>>> show' $ normalize $ mkMin 14 59 <> mkMs 132 9 <> Ms' 5308+15:01:17.317++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 decrementing, normalization is not yet implemented. todo+-}++incrDecr::(Int -> Int -> Int) -- ^ op (+) (-)+ -> DatePartSmall+ -> DatePartSmall+ -> DatePartSmall+incrDecr op0 dp1 dp2+ | (DatePartSmall d0 m0 ms0) <- dp1,+ (Day' d1) <- dp2+ = checkOverflow+ (\d2 -> DatePartSmall d2 m0 ms0) d0 op0 d1 -- 3++ | (DatePartSmall d0 m0 ms0) <- dp1,+ (Min' m1) <- dp2+ = checkOverflow+ (\m2 -> DatePartSmall d0 m2 ms0) m0 op0 m1 -- 4++ | (DatePartSmall d0 m0 ms0) <- dp1,+ (Ms' ms1) <- dp2+ = checkOverflow+ (DatePartSmall d0 m0) ms0 op0 ms1 -- 5++ | (Time m0 ms0) <- dp1,+ (Min' m1) <- dp2+ = checkOverflow (\m2 -> Time m2 ms0) m0 op0 m1 -- 6++ | (Time m0 ms0) <- dp1,+ (Ms' ms1) <- dp2+ = checkOverflow (Time m0) ms0 op0 ms1 -- 7++ | (Day m0) <- dp1,+ (Day' m1) <- dp2+ = checkOverflow Day m0 op0 m1 -- 8++ | (Min m0) <- dp1,+ (Min' m1) <- dp2+ = checkOverflow Min m0 op0 m1 -- 9++ | (Ms m0) <- dp1,+ (Ms' m1) <- dp2+ = checkOverflow Ms m0 op0 m1 -- 10++ | (Day' m0) <- dp1,+ (Day' m1) <- dp2+ = checkOverflow Day' m0 op0 m1 -- 8++ | (Min' m0) <- dp1,+ (Min' m1) <- dp2+ = checkOverflow Min' m0 op0 m1 -- 9++ | (Ms' m0) <- dp1,+ (Ms' m1) <- dp2+ = checkOverflow Ms' m0 op0 m1 -- 10++ | otherwise = Error Invalid+++++checkOverflow::forall a b. (Bounded a, Integral a, Num a) =>+ (a -> DatePartSmall) -- ^ ctor+ -> a+ -> (Int -> Int -> Int) -- ^ op (+) (-)+ -> a+ -> DatePartSmall+checkOverflow ctor0 a1 op0 a2 =+ if result1 >= min_aInt1+ && 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
+ src/Data/Time/Hora/Internal/Pad.hs view
@@ -0,0 +1,29 @@+module Data.Time.Hora.Internal.Pad+ (pad,pad') where+++{- | pad String with Char to total length of Int++ pad on left++ >>> pad '-' 5 "abc"++ "--abc" -}++pad::Char -> Int -> String -> String+pad c0 tot0 txt0 = p1 ++ txt0+ where p1 = pad_ c0 tot0 txt0+++{- | pad on right++ >>> pad' '-' 5 "abc"++ "abc--" -}+pad'::Char -> Int -> String -> String+pad' c0 tot0 txt0 = txt0 ++ p1+ where p1 = pad_ c0 tot0 txt0+++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
@@ -0,0 +1,59 @@+module Data.Time.Hora.Internal.Span where++{- | 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)++fi::TwoInt a b => a -> b+fi = fromIntegral++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++++{- | >>> 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+++-- | 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
src/Data/Time/Hora/Part.hs view
@@ -1,18 +1,27 @@--- | convert between 'UTCTime', 'UTCTimeBin' and 'DatePart'+-- | convert between 'UTCTime', 'UTCTimeBin', 'DatePart', 'DatePartSmall' module Data.Time.Hora.Part (-- * FromUTC FromUTC(..), fromUtc', -- * ToUTC- ToUTC(..)) where+ ToUTC(..),+ -- * 'DatePartSmall'+ mkDay,+ mkMin,+ mkMs,+ 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.Time.Hora.Span import Data.Time.Hora.Type import Data.Time.LocalTime as L-+import Data.Word class FromUTC a where fromUtc::UTCTime -> a@@ -24,9 +33,7 @@ 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+ (tod1, sec5, pico5) = todSecPico dt1 in DatePart { year = fi y1, month = fi m1,@@ -38,13 +45,43 @@ } +-- | extract (TimeIfDay, 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+ (sec5, MkFixed pico5) = properFraction pico4+++diffTime::Int -- ^ hour+ -> Int -- ^ minute+ -> Fixed E12 -- ^ pico+ -> DiffTime+diffTime h0 m0 p0 = timeOfDayToTime tod1+ where tod1 = TimeOfDay h0 m0 p0++ instance FromUTC UTCTimeBin where 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 t0 = DatePartSmall day2 minute2 milli2+ 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++++ {- | specified time zone Tz (DatePart a) parts show local date & time @@ -107,10 +144,114 @@ 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+ toUtc (UTCTimeBin day0 pico0) = Just $ UTCTime day1 diff1+ where day1 = ModifiedJulianDay day0+ diff1 = picosecondsToDiffTime pico0 -fi::TwoInt a b => a -> b-fi = fromIntegral ++instance ToUTC DatePartSmall where+ 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+ 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+ toUtc _ = Nothing+++{- | Julian day offset++https://en.wikipedia.org/wiki/Julian_day++>>> mkDay 1 1 1 `shouldBe` (Day 1)++>>> mkDay 1858 11 17 `shouldBe` (Day julian_day_offset)+-}+julian_day_offset::Integral a => a+julian_day_offset = fromIntegral 678576+++-- | day / date+mkDay::Integral a =>+ a -- ^ year+ -> a -- ^ month+ -> a -- ^ day+ -> DatePartSmall -- ^ '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+++-- | minutes including hours+mkMin::(Num a, Integral a) =>+ a -- ^ hour+ -> a -- ^ minute+ -> DatePartSmall -- ^ 'Min'+mkMin h0 m0 = Min $ fromIntegral $ h0 * 60 + m0+++-- | milliseconds including seconds+mkMs::(Num a, Integral a) =>+ a -- ^ second+ -> a -- ^ millisecond+ -> DatePartSmall -- ^ 'Ms'+mkMs s0 ms0 = Ms $ fromIntegral $ toMilli (Sec s0) + ms0+++{- | for ('Time', 'DatePartSmall') increase:++ minutes if seconds > 60++ days if minutes > 24 * 60++ ! does not change the constructor. 'Time' remains 'Time'++ this function is called by 'toUtc' before the conversion+-}+normalize::DatePartSmall -> DatePartSmall+normalize dp0+ | (Time m1 ms1) <- dp0,+ ms2::Int <- fi ms1,+ sec1 <- ts ms2,+ sec1 >= 60+ = let m3 = (sec1 `div` 60) + (fi m1::Int)+ sec2 = sec1 `rem` 60+ ms3 = (tm sec2) + ms2 - (tm sec1)+ in Time (fi m3) $ fi ms3++ | (DatePartSmall d1 m1 ms1) <- dp0,+ ms2::Int <- fi ms1,+ sec1 <- ts ms2,+ sec1 >= 60+ = let Time m2 ms2 = normalize $ Time m1 ms1+ in normalize $ DatePartSmall d1 m2 ms2++ | (DatePartSmall d1 m1 ms1) <- dp0,+ m2 <- fi m1::Int,+ hr1 <- m2 `div` 60,+ hr1 >= 24+ = let d2 = hr1 `div` 24 + (fi d1)+ hr2 = hr1 `rem` 24+ m3 = m2 `rem` 60 + hr2 * 60+ in DatePartSmall (fi d2) (fi m3) ms1++ | otherwise = dp0++tm::Integral a => a -> a+tm = toMilli . Sec++ts::Integral a => a -> a+ts = toSec . Milli
src/Data/Time/Hora/Span.hs view
@@ -19,40 +19,7 @@ import Data.Ratio import Data.Time.Clock import Data.Time.Hora.Type----- | 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+import Data.Time.Hora.Internal.Span toDiffTime::Integral a => TimeSpan a -> DiffTime@@ -66,11 +33,10 @@ 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 + where p0 = toPico ts0
src/Data/Time/Hora/Type.hs view
@@ -1,6 +1,12 @@ module Data.Time.Hora.Type - (-- * DatePart + (-- * DatePart DatePart(..),+ -- * DatePartSmall+ DatePartSmall(Day, Min, Ms, Time, DatePartSmall, Day', Min', Ms', Error),+ toSpan,+ negate,+ isNegative,+ ErrorDetail(..), -- * UTCTimeBin UTCTimeBin(..), -- * Tz@@ -12,9 +18,12 @@ import Data.Binary import Data.Time.Clock+import Data.Time.Hora.Internal.DatePartSmall+import Data.Time.Hora.Internal.Span import Data.Time.LocalTime import Data.Time.LocalTime.TimeZone.Series import GHC.Generics+import Prelude hiding (negate) {- | serializeable structure for essential Date, Time parts@@ -29,7 +38,7 @@ hour::a, minute::a, second::a,- pico::a -- ^ excludes seconds. Just fraction as Num + pico::a -- ^ excludes seconds. Just fraction as Integral } deriving (Show, Generic) @@ -81,9 +90,9 @@ -- private data Ord_ = Stop Bool | Continue -{- | 'UTCTimeBin' closely mimicks UTCTime.+{- | 'UTCTimeBin' closely mimicks 'UTCTime' without loss of precision -'UTCTimeBin' has 'Binary' instance. The only purpose of 'UTCTimeBin' is to offer faster conversion and more compact serialization of 'UTCTime' compared with 'DatePart'.+'UTCTimeBin' has 'Binary' instance. The only purpose of 'UTCTimeBin' is to offer faster conversion from / to 'UTCTime' and more compact serialization compared with 'DatePart'. see "Data.Time.Hora.Part" for conversion between 'UTCTime' and 'UTCTimeBin' -} data UTCTimeBin = UTCTimeBin {@@ -119,18 +128,8 @@ use of 'TimeZoneSeries' is preferred when converting from 'UTCTime' to 'DatePart' -} -{- | 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@@ -176,27 +175,3 @@ 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
test/Main.hs view
@@ -13,10 +13,17 @@ import qualified Test.TestTime as Tt import qualified Test.TestUTCTimeBin as Bin 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+ Of.main T.main Conv.main Fut.main@@ -30,3 +37,9 @@ Tcom.main Tf.main Bin.main+ A.main+ Sm.main+ Sto.main+ Smc.main+ Pm.main+ Smd.main
+ test/Test/TestAncientDate.hs view
@@ -0,0 +1,31 @@+module Test.TestAncientDate where++import Data.Maybe+import Data.Time.Hora.Part+import Data.Time.Hora.Type+import Debug.Trace+import Test.Hspec++main::IO()+main = hspec $ do+ describe "day way in the past" $ do+ it "year 1" $ do+ traceIO $ "year 1: " <> (show utc1)+ traceIO $ "year 1: " <> (show utcbin1)+ 1 `shouldBe` 1+ it "year 500" $ do+ isJust utc2 `shouldBe` True+ dp3 `shouldBe` (dp1 500)+ where utc1 = fromJust $ toUtc $ dp1 1+ utcbin1 = fromUtc utc1::UTCTimeBin+ dp1 y1 = DatePart {+ year = y1,+ month = 1,+ day = 1,+ hour = 0,+ minute = 0,+ second = 0,+ pico = 0+ }::DatePart Int+ utc2 = toUtc $ dp1 500+ dp3 = fromUtc $ fromJust utc2::DatePart Int
+ test/Test/TestCheckOverflow.hs view
@@ -0,0 +1,20 @@+module Test.TestCheckOverflow where++import Data.Word+import Data.Time.Hora.Internal.DatePartSmall+import Test.Hspec+++main::IO()+main = hspec $ do+ describe "TestCheckOverflow" $ do+ it "addition succeeds" $ do+ let result1 = checkOverflow Min' 3 (+) 10+ result1 `shouldBe` (Min' 13)+ it "addition maxes out" $ do+ let result1 = checkOverflow Min' max16 (+) 10+ result1 `shouldBe` (Error Overflow)+ it "negation maxes out" $ do+ let result1 = checkOverflow Min' 20 (-) 100+ result1 `shouldBe` (Error Overflow)+ where max16 = maxBound::Word16
+ test/Test/TestDatePartSmall.hs view
@@ -0,0 +1,118 @@+module Test.TestDatePartSmall where++import Data.Semigroup hiding (Min)+import Data.Time.Hora.Internal.DatePartSmall+import Prelude hiding (negate)+import Test.Hspec+++main::IO()+main = hspec $ do+ describe "TestDatePartSmall merge" $ do+ it "1 Day <> Time" $ do+ Day 2 <> Time 3 5 `shouldBe` DatePartSmall 2 3 5+ it "2 Min <> Ms" $ do+ Min 2 <> Ms 3 `shouldBe` Time 2 3++ describe "TestDatePartSmall increment" $ do+ it "3" $ do+ DatePartSmall 1 2 3 <> Day' 2 `shouldBe` DatePartSmall 3 2 3+ it "4" $ do+ DatePartSmall 1 2 3 <> Min' 2 `shouldBe` DatePartSmall 1 4 3+ it "5" $ do+ DatePartSmall 1 2 3 <> Ms' 2 `shouldBe` DatePartSmall 1 2 5+ it "6" $ do+ Time 2 3 <> Min' 2 `shouldBe` Time 4 3+ it "7" $ do+ Time 2 3 <> Ms' 2 `shouldBe` Time 2 5+ it "8" $ do+ Day 1 <> Day' 2 `shouldBe` Day 3+ it "9" $ do+ Min 1 <> Min' 2 `shouldBe` Min 3+ it "10" $ do+ Ms 1 <> Ms' 2 `shouldBe` Ms 3++ it "8: 2 x spans" $ do+ Day' 1 <> Day' 2 `shouldBe` Day' 3+ it "9: 2 x spans" $ do+ Min' 1 <> Min' 2 `shouldBe` Min' 3+ it "10: 2 x spans" $ do+ Ms' 1 <> Ms' 2 `shouldBe` Ms' 3++ describe "TestDatePartSmall decrement" $ do+ it "3" $ do+ DatePartSmall 10 2 3 <> negate (Day' 2) `shouldBe` DatePartSmall 8 2 3+ it "4" $ do+ DatePartSmall 1 2 3 <> negate (Min' 2) `shouldBe` DatePartSmall 1 0 3+ it "5" $ do+ DatePartSmall 1 2 3 <> negate (Ms' 2) `shouldBe` DatePartSmall 1 2 1+ it "6" $ do+ Time 20 3 <> negate (Min' 2) `shouldBe` Time 18 3+ it "7" $ do+ Time 2 30 <> negate (Ms' 5) `shouldBe` Time 2 25+ it "8" $ do+ Day 10 <> negate (Day' 2) `shouldBe` Day 8+ it "9" $ do+ Min 10 <> negate (Min' 3) `shouldBe` Min 7+ it "10" $ do+ Ms 100 <> negate (Ms' 12) `shouldBe` Ms 88++ it "8: 2 x spans" $ do+ Day' 10 <> negate (Day' 4) `shouldBe` Day' 6+ it "9: 2 x spans" $ do+ Min' 14 <> negate (Min' 2) `shouldBe` Min' 12+ it "10: 2 x spans" $ do+ Ms' 23 <> negate (Ms' 2) `shouldBe` Ms' 21++ it "8: 2 x spans" $ do+ Day' 10 <> negate (Day' 4) `shouldBe` Day' 6+ it "9: 2 x spans" $ do+ Min' 14 <> negate (Min' 2) `shouldBe` Min' 12+ it "10: 2 x spans" $ do+ Ms' 23 <> negate (Ms' 2) `shouldBe` Ms' 21++ it "8: 2 x spans" $ do+ negate (Day' 10) <> negate (Day' 4) `shouldBe` (negate $ Day' 14)+ it "9: 2 x spans" $ do+ negate (Min' 14) <> negate (Min' 2) `shouldBe` (negate $ Min' 16)+ it "10: 2 x spans" $ do+ negate (Ms' 23) <> negate (Ms' 2) `shouldBe` (negate $ Ms' 25)++ describe "TestDatePartSmall overwrite" $ do+ it "11" $ do+ DatePartSmall 1 2 3 <> DatePartSmall 5 6 7 `shouldBe` DatePartSmall 5 6 7+ it "12" $ do+ Time 2 3 <> Time 7 8 `shouldBe` Time 7 8+ it "13" $ do+ Day 3 <> Day 8 `shouldBe` Day 8+ it "14" $ do+ Min 1 <> Min 20 `shouldBe` Min 20+ it "15" $ do+ Ms 1 <> Ms 20 `shouldBe` Ms 20++ describe "TestDatePartSmall update" $ do+ it "16" $ do+ DatePartSmall 1 2 3 <> Time 5 6 `shouldBe` DatePartSmall 1 5 6+ it "17" $ do+ Time 2 3 <> Min 8 `shouldBe` Time 8 3+ it "18" $ do+ Time 2 3 <> Ms 8 `shouldBe` Time 2 8++ it "19" $ do+ Error Invalid <> Error Invalid `shouldBe` Error Invalid+ it "20" $ do+ Error Invalid <> Error Overflow `shouldBe` Error Invalid_Overflow+ it "21" $ do+ Error Overflow <> Error Overflow `shouldBe` Error Overflow+ it "22" $ do+ Error Overflow <> Error Invalid ` shouldBe ` Error Invalid_Overflow+ it "23" $ do+ Error Invalid_Overflow <> Min 1 ` shouldBe ` Error Invalid_Overflow+ it "24" $ do+ Min 1 <> Error Invalid_Overflow ` shouldBe ` Error Invalid_Overflow+ it "25" $ do+ Error Overflow <> Min 1 ` shouldBe ` Error Overflow+ it "26" $ do+ Day 3 <> Error Invalid ` shouldBe ` Error Invalid+ it "27" $ do+ Time 1 2 <> Day 3 `shouldBe` Error Invalid
+ test/Test/TestDatePartSmallConvert.hs view
@@ -0,0 +1,40 @@+module Test.TestDatePartSmallConvert where++import Data.Maybe+import Data.Time.Clock+import Data.Time.Hora.Future as F+import Data.Time.Hora.Internal.DatePartSmall+import Data.Time.Hora.Internal.Span+import Data.Time.Hora.Part+import Data.Time.Hora.Stamp+import Data.Time.Hora.Type+import Debug.Trace+import Prelude as P+import Test.Hspec++main::IO()+main = hspec $ do+ describe "TestDatePartSmallConvert" $ do+ it "now <-> DatePartSmall" $ do+ now1 <- now::IO UTCTime+ let small1 = fromUtc now1::DatePartSmall+ Just utc2 = toUtc small1+ span3 = utc2 F.- now1::TimeSpan Integer+ traceIO $ show small1+ abs span3 `shouldSatisfy` (< (Milli 1))+ it "normalize DatePartSmall" $ do+ normalize (Time 0 $ toMilli $ Sec 62) `shouldBe` (Time 1 $ toMilli $ Sec 2)+ normalize (DatePartSmall 0 (60 * 24 + 10) $ toMilli $ Sec 62) `shouldBe` (DatePartSmall 1 11 $ toMilli $ Sec 2)+ (mkMin 14 59 <> mkMs 132 9 <> Ms' 5300) `shouldBe` (mkMin 14 59) <> (mkMs 132 5309)+ normalize (mkMin 14 59 <> mkMs 132 9 <> Ms' 5300) `shouldBe` (mkMin 15 1) <> (mkMs 17 309)+ it "increment DatePartSmall by 1 day in minutes" $ do+ now1 <- now::IO UTCTime+ let small1 = fromUtc now1::DatePartSmall+ incremented1 = small1 <> (toSpan $ mkMin 24 0)+ Just utcNow2 = toUtc small1+ Just utcIncr3 = toUtc incremented1+ 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
+ test/Test/TestDatePartSmallDoc.hs view
@@ -0,0 +1,47 @@+module Test.TestDatePartSmallDoc where++import Data.Maybe+import Data.Semigroup hiding (Min)+import Data.Time.Clock+import Data.Time.Hora.Part+import Data.Time.Hora.Format+import Data.Time.Hora.Type+import Data.Word+import Debug.Trace+import Prelude+import Test.Hspec+++main::IO()+main = hspec $ do+ describe "TestDatePartSmall" $ do+ it "day 1" $ do+ mkDay 1 1 1 `shouldBe` (Day 1)+ it "Modified Julian day" $ do+ mkDay 1858 11 17 `shouldBe` (Day julian_day_offset)+ it "mkDay" $ do+ mkDay 2018 08 16 `shouldBe` (Day 736922)+ it "max day" $ do+ let d1 = Day (maxBound::Word32)+ Just utc2 = toUtc $ d1 <> (Time 0 0)+ traceIO $ "max date: " <> (show utc2)+ 1 `shouldBe` 1+ it "round trip DatePartSmall <-> UTCTime <-> DatePart" $ do+ let d1 = mkDay 2018 8 16::DatePartSmall+ dt1 = d1 <> Time 0 0::DatePartSmall+ utc2 = fromJust $ toUtc dt1::UTCTime+ dp3 = fromUtc utc2+ DatePartSmall d4 _ _ = fromUtc utc2::DatePartSmall+ year dp3 `shouldBe` 2018+ month dp3 `shouldBe` 8+ day dp3 `shouldBe` 16+ d4 `shouldBe` 736922+ describe "TestDatePartSmall show results" $ do+ it "display " $ do+ show' (mkDay 2018 8 20 <> mkMin 10 2 <> mkMs 30 9) `shouldBe` "2018-08-20 10:02:30.009"+ show' (mkDay 2018 1 1 <> Day' 20) `shouldBe` "2018-01-21"+ show' (mkDay 2018 1 1 <> Day' 180) `shouldBe` "2018-06-30"+ show' (mkMin 3 15 <> Min' 200) `shouldBe` "06:35"+ show' (normalize $ mkMin 14 59 <> mkMs 132 9 <> Ms' 5308) `shouldBe` "15:01:17.317"+ show' (mkMs 132 9) `shouldBe` "132.009"+ show' (mkMs 132 9 <> Ms' 5300) `shouldBe` "137.309"
test/Test/TestFormat.hs view
@@ -1,8 +1,9 @@ module Test.TestFormat where import Data.Time.Hora.Format+import Data.Time.Hora.Part import Data.Time.Hora.Stamp-import Data.Time.Hora.Type+import Data.Time.Hora.Type as T import Debug.Trace import Test.Hspec @@ -28,6 +29,38 @@ it "week of year" $ do ts [Wk_year_Mon, " ", Wk_year_Sun] >>= utc 1 `shouldBe` 1++ describe "TestFormat show DatePartSmall" $ do+ it "Day" $ do+ show' (mkDay 2018 08 17) `shouldBe` "2018-08-17"+ it "Min" $ do+ show' (mkMin 4 3) `shouldBe` "04:03"+ it "Ms" $ do+ show' (mkMs 7 318) `shouldBe` "07.318"+ it "Time" $ do+ let (T.Min m1) = mkMin 5 7+ (T.Ms ms1) = mkMs 7 58+ show' (T.Time m1 ms1) `shouldBe` "05:07:07.058"+ it "DatePartSmall" $ do+ let (T.Day d1) = mkDay 2018 08 17+ (T.Min m1) = mkMin 15 17+ (T.Ms ms1) = mkMs 7 358+ show' (T.DatePartSmall d1 m1 ms1) `shouldBe` "2018-08-17 15:17:07.358"+ it "Day'" $ do+ show' (Day' 3) `shouldBe` "+3"+ it "Min'" $ do+ show' (toSpan $ mkMin 14 53) `shouldBe` "+14:53"+ show' (toSpan $ mkMin 0 53) `shouldBe` "+00:53"+ it "Ms'" $ do+ show' (toSpan $ mkMs 7 0) `shouldBe` "+07.000"+ it "Neg Day'" $ do+ show' (T.negate $ Day' 3) `shouldBe` "-3"+ it "Neg Min'" $ do+ show' (T.negate $ toSpan $ mkMin 14 53) `shouldBe` "-14:53"+ show' (T.negate $ toSpan $ mkMin 0 53) `shouldBe` "-00:53"+ it "Neg Ms'" $ do+ show' (T.negate $ toSpan $ mkMs 7 358) `shouldBe` "-07.358"+ show' (T.negate $ toSpan $ mkMs 0 0) `shouldBe` "-00.000" utc::Tz String -> IO()
+ test/Test/TestRoundtripPicoMilli.hs view
@@ -0,0 +1,32 @@+module Test.TestRoundtripPicoMilli where++import Data.Time.Clock+import Data.Time.Hora.Part+import Data.Time.Hora.Span+import Data.Time.Hora.Stamp+import Data.Time.Hora.Type+import Data.Word+import Debug.Trace+import Test.Hspec+++main::IO()+main = hspec $ do+ describe "TestRoundtripPicoMilli" $ do+ it "round trip pico" $ do+ now1 <- now::IO UTCTime+ let dp1 = fromUtc now1::DatePart Int+ pico1 = pico dp1::Int+ milli2 = fromSec3 + fromPico3::Word32++ fromSec3 = toMilli (Sec $ second dp1)::Word32+ fromPico3 = toMilli $ Pico pico1+ tr1 "pico1: " pico1+ tr1 "sec1: " $ second dp1+ tr1 "milli2: " milli2++ -- back+ let pico5 = toPico $ Milli milli2::Int+ tr1 "pico5: " pico5+ 1 `shouldBe` 1+ where tr1 desc1 data1 = traceIO $ "TestRoundtripPicoMilli " <> desc1 <> show data1
+ test/Test/TestStorageSize.hs view
@@ -0,0 +1,71 @@+module Test.TestStorageSize where++import Data.Binary+import qualified Data.ByteString as B (concat,length)+import qualified Data.ByteString.Lazy as L (toChunks)+import Data.Int+import Data.Time.Clock+import Data.Time.Hora.Part+import Data.Time.Hora.Stamp+import Data.Time.Hora.Type+import Debug.Trace+import Prelude as P+import Test.Hspec+++main::IO()+main = hspec $ do+ describe "compare binary size" $ do+ it "Min 10" $ do+ let result1 = Min 10+ bin2 = encode result1+ tr1 "Min 10 size is " bin2+ size1 bin2 `shouldBe` 3+ it "Day 10" $ do+ let result1 = Day 10+ bin2 = encode result1+ tr1 "Day 10 size is " bin2+ size1 bin2 `shouldBe` 5+ it "Day max" $ do+ let result1 = Day (maxBound::Word32)+ bin2 = encode result1+ tr1 "Day max size is " bin2+ size1 bin2 `shouldBe` 5+ it "Ms 10" $ do+ let result1 = Ms 10+ bin2 = encode result1+ tr1 "Ms 10 size is " bin2+ size1 bin2 `shouldBe` 5+ it "Time 1 2" $ do+ let result1 = Time 1 2+ bin2 = encode result1+ tr1 "Time 1 2 size is " bin2+ size1 bin2 `shouldBe` 7+ it "DatePartSmall 10 2 1" $ do+ let result1 = DatePartSmall 10 2 1+ bin2 = encode result1+ tr1 "DatePartSmall size is " bin2+ size1 bin2 `shouldBe` 11+ it "DatePartSmall from now" $ do+ now20 <- now::IO UTCTime+ let result1 = fromUtc now20::DatePartSmall+ bin1 = encode result1+ tr1 "DatePartSmall now size is " bin1+ size1 bin1 `shouldBe` 11+ let result2 = fromUtc now20::UTCTimeBin+ bin2 = encode result2+ tr1 "UTCTimeBin now size is " bin2+-- size1 bin2 `shouldBe` 22+ let result3 = fromUtc now20::DatePart Int+ bin3 = encode result3+ tr1 "DatePart Int now size is " bin3+-- size1 bin3 `shouldBe` 56+ it "Int64" $ do+ let result1 = 10::Int64+ bin2 = encode result1+ tr1 "Int64 size is " bin2+ size1 bin2 `shouldBe` 8+ where tr1 desc1 bin1 = traceIO $ desc1 <> (show $ size1 bin1)+ size1 bin1 = B.length $ B.concat $ L.toChunks bin1++
test/Test/TestUTCTimeBin.hs view
@@ -3,6 +3,7 @@ import Data.Binary import Data.ByteString.Lazy import Data.Maybe+import Data.Time.Clock import Data.Time.Hora.Part import Data.Time.Hora.Stamp import Data.Time.Hora.Type@@ -14,7 +15,7 @@ main = hspec $ do describe "round trip convert & serialize UTCTime via UTCTimeBin" $ do it "round trip convert" $ do- utc1 <- now+ utc1 <- now::IO UTCTime let utcbin2 = fromUtc utc1::UTCTimeBin utc2 = fromJust $ toUtc utcbin2 traceIO $ show utc1@@ -22,7 +23,7 @@ traceIO $ show utc2 utc2 `shouldBe` utc1 it "round trip convert & serialize" $ do- utc10 <- now+ utc10 <- now::IO UTCTime let utcbin10 = fromUtc utc10::UTCTimeBin bin11 = encode utcbin10::ByteString utcbin12 = decode bin11::UTCTimeBin