packages feed

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 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