diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -1,3 +1,7 @@ +0.12.0.0 +-------- +* Quit using internal .NET TimeSpan for dotnet-timespan TimeSpan + 0.11.0.0 -------- * Implement Cluster connection. diff --git a/Database/EventStore.hs b/Database/EventStore.hs --- a/Database/EventStore.hs +++ b/Database/EventStore.hs @@ -95,27 +95,6 @@ , setACL , modifyACL , setCustomProperty - -- * TimeSpan - , TimeSpan - , timeSpanTicks - , timeSpanHoursMinsSecs - , timeSpanDaysHoursMinsSecs - , timeSpanDaysHoursMinsSecsMillis - , timeSpanGetTicks - , timeSpanGetDays - , timeSpanGetHours - , timeSpanGetMinutes - , timeSpanGetSeconds - , timeSpanGetMillis - , timeSpanFromSeconds - , timeSpanFromMinutes - , timeSpanFromHours - , timeSpanFromDays - , timeSpanTotalDays - , timeSpanTotalHours - , timeSpanTotalMinutes - , timeSpanTotalSeconds - , timeSpanTotalMillis -- * Transaction , Transaction , TransactionId @@ -230,7 +209,6 @@ import Database.EventStore.Internal.Operation.Read.Common import Database.EventStore.Internal.Operation.Write.Common import Database.EventStore.Internal.Stream -import Database.EventStore.Internal.TimeSpan import Database.EventStore.Internal.Types import Database.EventStore.Internal.Execution.Production diff --git a/Database/EventStore/Internal/Discovery.hs b/Database/EventStore/Internal/Discovery.hs --- a/Database/EventStore/Internal/Discovery.hs +++ b/Database/EventStore/Internal/Discovery.hs @@ -51,6 +51,7 @@ import Data.Aeson.Types import Data.Array.IO import Data.ByteString (ByteString) +import Data.DotNet.TimeSpan import Data.Int import Data.List.NonEmpty (NonEmpty) import Data.UUID @@ -59,9 +60,6 @@ import System.Random -------------------------------------------------------------------------------- -import Database.EventStore.Internal.TimeSpan - --------------------------------------------------------------------------------- data DnsDiscoveryException = MaxDiscoveryAttemptReached ByteString | DNSDiscoveryError DNSError @@ -197,7 +195,7 @@ , clusterMaxDiscoverAttempts = 10 , clusterExternalGossipPort = 0 , clusterGossipSeeds = Just xs - , clusterGossipTimeout = timeSpanFromSeconds 1 + , clusterGossipTimeout = fromSeconds 1 , clusterDnsServer = Nothing } @@ -214,7 +212,7 @@ clusterMaxDiscoverAttempts = 10 clusterExternalGossipPort = 0 clusterGossipSeeds = Nothing - clusterGossipTimeout = timeSpanFromSeconds 1 + clusterGossipTimeout = fromSeconds 1 clusterDnsServer = Nothing -------------------------------------------------------------------------------- @@ -341,7 +339,7 @@ -> IO (Maybe ClusterInfo) tryGetGossipFrom ClusterSettings{..} mgr seed = do init_req <- httpRequest (gossipEndpoint seed) "/gossip?format=json" - let timeout = truncate (timeSpanTotalMillis clusterGossipTimeout * 1000) + let timeout = truncate (totalMillis clusterGossipTimeout * 1000) req = init_req { responseTimeout = Just timeout } resp <- httpLbs req mgr return $ decode $ responseBody resp @@ -428,7 +426,7 @@ -------------------------------------------------------------------------------- resolveDns :: ClusterSettings -> IO (IOArray Int GossipSeed) resolveDns ClusterSettings{..} = do - let timeoutMicros = timeSpanTotalMillis clusterGossipTimeout * 1000 + let timeoutMicros = totalMillis clusterGossipTimeout * 1000 conf = case clusterDnsServer of Nothing -> defaultResolvConf diff --git a/Database/EventStore/Internal/Manager/Subscription/Message.hs b/Database/EventStore/Internal/Manager/Subscription/Message.hs --- a/Database/EventStore/Internal/Manager/Subscription/Message.hs +++ b/Database/EventStore/Internal/Manager/Subscription/Message.hs @@ -20,11 +20,11 @@ import GHC.Generics (Generic) -------------------------------------------------------------------------------- +import Data.DotNet.TimeSpan import Data.ProtocolBuffers import Data.Text (Text) -------------------------------------------------------------------------------- -import Database.EventStore.Internal.TimeSpan import Database.EventStore.Internal.Types -------------------------------------------------------------------------------- @@ -135,7 +135,7 @@ , cpsMsgTimeout = putField . fromIntegral . (truncate :: Double -> Int64) - . timeSpanTotalMillis + . totalMillis $ psSettingsMsgTimeout sett , cpsRecordStats = putField $ psSettingsExtraStats sett , cpsLiveBufSize = putField $ psSettingsLiveBufSize sett @@ -146,7 +146,7 @@ , cpsChkPtAfterTime = putField . fromIntegral . (truncate :: Double -> Int64) - . timeSpanTotalMillis + . totalMillis $ psSettingsCheckPointAfter sett , cpsChkPtMaxCount = putField $ psSettingsMaxCheckPointCount sett , cpsChkPtMinCount = putField $ psSettingsMinCheckPointCount sett @@ -256,7 +256,7 @@ , upsMsgTimeout = putField . fromIntegral . (truncate :: Double -> Int64) - . timeSpanTotalMillis + . totalMillis $ psSettingsMsgTimeout sett , upsRecordStats = putField $ psSettingsExtraStats sett , upsLiveBufSize = putField $ psSettingsLiveBufSize sett @@ -267,7 +267,7 @@ , upsChkPtAfterTime = putField . fromIntegral . (truncate :: Double -> Int64) - . timeSpanTotalMillis + . totalMillis $ psSettingsCheckPointAfter sett , upsChkPtMaxCount = putField $ psSettingsMaxCheckPointCount sett , upsChkPtMinCount = putField $ psSettingsMinCheckPointCount sett diff --git a/Database/EventStore/Internal/TimeSpan.hs b/Database/EventStore/Internal/TimeSpan.hs deleted file mode 100644 --- a/Database/EventStore/Internal/TimeSpan.hs +++ /dev/null @@ -1,339 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} --------------------------------------------------------------------------------- --- | --- Module : Database.EventStore.Internal.TimeSpan --- Copyright : (C) 2015 Yorick Laupa --- License : (see the file LICENSE) --- --- Maintainer : Yorick Laupa --- Stability : provisional --- Portability : non-portable --- --- .NET TimeSpan implemented in Haskell. --------------------------------------------------------------------------------- -module Database.EventStore.Internal.TimeSpan - ( TimeSpan - , timeSpanTicks - , timeSpanHoursMinsSecs - , timeSpanDaysHoursMinsSecs - , timeSpanDaysHoursMinsSecsMillis - , timeSpanGetTicks - , timeSpanGetDays - , timeSpanGetHours - , timeSpanGetMinutes - , timeSpanGetSeconds - , timeSpanGetMillis - , timeSpanFromSeconds - , timeSpanFromMinutes - , timeSpanFromHours - , timeSpanFromDays - , timeSpanTotalDays - , timeSpanTotalHours - , timeSpanTotalMinutes - , timeSpanTotalSeconds - , timeSpanTotalMillis - ) where - --------------------------------------------------------------------------------- -import Data.Int -import Data.Monoid -import Prelude - --------------------------------------------------------------------------------- -import Data.Text.Lazy (unpack) -import Data.Text.Lazy.Builder - --------------------------------------------------------------------------------- --- | .NET TimeSpan: Represents a time interval. -newtype TimeSpan = TimeSpan Int64 deriving (Eq, Ord) - --------------------------------------------------------------------------------- -instance Show TimeSpan where - show = unpack . toLazyText . timeSpanBuilder - --------------------------------------------------------------------------------- -millisPerSecond :: Int64 -millisPerSecond = 1000 - --------------------------------------------------------------------------------- -millisPerMinute :: Int64 -millisPerMinute = millisPerSecond * 60 - --------------------------------------------------------------------------------- -millisPerHour :: Int64 -millisPerHour = millisPerMinute * 60 - --------------------------------------------------------------------------------- -millisPerDay :: Int64 -millisPerDay = millisPerHour * 24 - --------------------------------------------------------------------------------- -ticksPerMillisecond :: Int64 -ticksPerMillisecond = 10000 - --------------------------------------------------------------------------------- -ticksPerSecond :: Int64 -ticksPerSecond = ticksPerMillisecond * 1000 - --------------------------------------------------------------------------------- -ticksPerMinute :: Int64 -ticksPerMinute = ticksPerSecond * 60 - --------------------------------------------------------------------------------- -ticksPerHour :: Int64 -ticksPerHour = ticksPerMinute * 60 - --------------------------------------------------------------------------------- -ticksPerDay :: Int64 -ticksPerDay = ticksPerHour * 24 - --------------------------------------------------------------------------------- -daysPerTick :: Double -daysPerTick = 1 / (realToFrac ticksPerDay) - --------------------------------------------------------------------------------- -hoursPerTick :: Double -hoursPerTick = 1 / (realToFrac ticksPerHour) - --------------------------------------------------------------------------------- -minutesPerTick :: Double -minutesPerTick = 1 / (realToFrac ticksPerMinute) - --------------------------------------------------------------------------------- -secondsPerTick :: Double -secondsPerTick = 1 / (realToFrac ticksPerSecond) - --------------------------------------------------------------------------------- -millisPerTick :: Double -millisPerTick = 1 / (realToFrac ticksPerMillisecond) - --------------------------------------------------------------------------------- -maxMillis :: Int64 -maxMillis = - truncate - (((realToFrac (maxBound :: Int64) :: Double) - / realToFrac ticksPerMillisecond) :: Double) - --------------------------------------------------------------------------------- -minMillis :: Int64 -minMillis = - truncate - (((realToFrac (minBound :: Int64) :: Double) - / realToFrac ticksPerMillisecond) :: Double) - --------------------------------------------------------------------------------- --- | Initializes a new instance of the TimeSpan structure to the specified --- number of ticks. -timeSpanTicks :: Int64 -> TimeSpan -timeSpanTicks = TimeSpan - --------------------------------------------------------------------------------- --- | Initializes a new instance of the TimeSpan structure to a specified number --- of hours, minutes, and seconds. -timeSpanHoursMinsSecs :: Int64 -> Int64 -> Int64 -> TimeSpan -timeSpanHoursMinsSecs hh mm ss = TimeSpan $ totalSecs * ticksPerSecond - where - totalSecs = (hh * 3600) + (mm * 60) + ss - --------------------------------------------------------------------------------- --- | Initializes a new instance of the TimeSpan structure to a specified number --- of days, hours, minutes, and seconds. -timeSpanDaysHoursMinsSecs :: Int64 -> Int64 -> Int64 -> Int64 -> TimeSpan -timeSpanDaysHoursMinsSecs dd hh mm ss = - timeSpanDaysHoursMinsSecsMillis dd hh mm ss 0 - --------------------------------------------------------------------------------- --- | Initializes a new instance of the TimeSpan structure to a specified number --- of days, hours, minutes, seconds, and milliseconds. -timeSpanDaysHoursMinsSecsMillis :: Int64 - -> Int64 - -> Int64 - -> Int64 - -> Int64 - -> TimeSpan -timeSpanDaysHoursMinsSecsMillis dd hh mm ss ms = - TimeSpan $ totalMillis * ticksPerMillisecond - where - totalMillis = ((dd * 3600 * 24) + - (hh * 3600) + - (mm * 60) + - ss) * 1000 + ms - --------------------------------------------------------------------------------- --- | Gets the number of ticks that represent the value of the current 'TimeSpan' --- structure. -timeSpanGetTicks :: TimeSpan -> Int64 -timeSpanGetTicks (TimeSpan i) = i - --------------------------------------------------------------------------------- --- | Gets the days component of the time interval represented by the current --- 'TimeSpan' structure. -timeSpanGetDays :: TimeSpan -> Int64 -timeSpanGetDays (TimeSpan i) = truncate $ - (realToFrac i :: Double) / - (realToFrac ticksPerDay) - --------------------------------------------------------------------------------- --- | Gets the hours component of the time interval represented by the current --- 'TimeSpan' structure. -timeSpanGetHours :: TimeSpan -> Int64 -timeSpanGetHours (TimeSpan i) = mod (truncate $ - (realToFrac i :: Double) / - (realToFrac ticksPerHour)) 24 - --------------------------------------------------------------------------------- --- | Gets the minutes component of the time interval represented by the current --- 'TimeSpan' structure. -timeSpanGetMinutes :: TimeSpan -> Int64 -timeSpanGetMinutes (TimeSpan i) = mod (truncate $ - (realToFrac i :: Double) / - (realToFrac ticksPerMinute)) 60 - --------------------------------------------------------------------------------- --- | Gets the seconds component of the time interval represented by the current --- 'TimeSpan' structure. -timeSpanGetSeconds :: TimeSpan -> Int64 -timeSpanGetSeconds (TimeSpan i) = mod (truncate $ - (realToFrac i :: Double) / - (realToFrac ticksPerSecond)) 60 - --------------------------------------------------------------------------------- --- | Gets the milliseconds component of the time interval represented by the --- current 'TimeSpan' structure. -timeSpanGetMillis :: TimeSpan -> Int64 -timeSpanGetMillis (TimeSpan i) = mod (truncate $ - (realToFrac i :: Double) / - (realToFrac ticksPerMillisecond)) 1000 - --------------------------------------------------------------------------------- --- | Returns a 'TimeSpan' that represents a specified number of seconds, where --- the specification is accurate to the nearest millisecond. -timeSpanFromSeconds :: Double -> TimeSpan -timeSpanFromSeconds i = interval i millisPerSecond - --------------------------------------------------------------------------------- --- | Returns a 'TimeSpan' that represents a specified number of minutes, where --- the specification is accurate to the nearest millisecond. -timeSpanFromMinutes :: Double -> TimeSpan -timeSpanFromMinutes i = interval i millisPerMinute - --------------------------------------------------------------------------------- --- | Returns a 'TimeSpan' that represents a specified number of hours, where the --- specification is accurate to the nearest millisecond. -timeSpanFromHours :: Double -> TimeSpan -timeSpanFromHours i = interval i millisPerHour - --------------------------------------------------------------------------------- --- | Returns a 'TimeSpan' that represents a specified number of days, where the --- specification is accurate to the nearest millisecond. -timeSpanFromDays :: Double -> TimeSpan -timeSpanFromDays i = interval i millisPerDay - --------------------------------------------------------------------------------- --- | Gets the value of the current 'TimeSpan' structure expressed in whole and --- fractional days. -timeSpanTotalDays :: TimeSpan -> Double -timeSpanTotalDays (TimeSpan i) = (realToFrac i) * daysPerTick - --------------------------------------------------------------------------------- --- | Gets the value of the current 'TimeSpan' structure expressed in whole and --- fractional hours. -timeSpanTotalHours :: TimeSpan -> Double -timeSpanTotalHours (TimeSpan i) = (realToFrac i) * hoursPerTick - --------------------------------------------------------------------------------- --- | Gets the value of the current 'TimeSpan' structure expressed in whole and --- fractional minutes. -timeSpanTotalMinutes :: TimeSpan -> Double -timeSpanTotalMinutes (TimeSpan i) = (realToFrac i) * minutesPerTick - --------------------------------------------------------------------------------- --- | Gets the value of the current 'TimeSpan' structure expressed in whole and --- fractional seconds. -timeSpanTotalSeconds :: TimeSpan -> Double -timeSpanTotalSeconds (TimeSpan i) = (realToFrac i) * secondsPerTick - --------------------------------------------------------------------------------- --- | Gets the value of the current 'TimeSpan' structure expressed in whole and --- fractional milliseconds. -timeSpanTotalMillis :: TimeSpan -> Double -timeSpanTotalMillis (TimeSpan i) = - let tmp = (realToFrac i) * millisPerTick in - if tmp > (realToFrac maxMillis) then realToFrac maxMillis - else if tmp < (realToFrac minMillis) then realToFrac minMillis - else tmp - --------------------------------------------------------------------------------- -data FormatLiteral = Positive | Negative - --------------------------------------------------------------------------------- -padded :: Int -> a -> [a] -> [a] -padded n p xs = replicate diff p ++ xs - where - len_xs = length xs - diff = n - len_xs - --------------------------------------------------------------------------------- -timeSpanBuilder :: TimeSpan -> Builder -timeSpanBuilder (TimeSpan ticks) = - start <> - genDay <> - genHours <> - genMins <> - genSecs <> - genFract - - where - ticksPerHourD = realToFrac ticksPerHour :: Double - ticksPerDayD = realToFrac ticksPerDay :: Double - ticksPerMinuteD = realToFrac ticksPerMinute :: Double - ticksPerSecondD = realToFrac ticksPerSecond :: Double - - day :: Int64 - day = truncate $ realToFrac ticks / ticksPerDayD - - time = ticks `mod` ticksPerDay - - cday = if ticks < 0 then negate day else day - ctime = if ticks < 0 then negate time else time - - hours :: Int64 - hours = mod (truncate (realToFrac ctime / ticksPerHourD)) 24 - - mins :: Int64 - mins = mod (truncate (realToFrac ctime / ticksPerMinuteD)) 60 - - secs :: Int64 - secs = mod (truncate (realToFrac ctime / ticksPerSecondD)) 60 - - fraction :: Int64 - fraction = ctime `mod` ticksPerSecond - - literal = if ticks < 0 then Negative else Positive - - start = - case literal of - Positive -> fromText "" - Negative -> fromText "-" - - genDay = - if cday /= 0 - then fromString (show cday) <> fromText "." - else mempty - - genHours = fromString (padded 2 '0' $ show hours) <> ":" - genMins = fromString (padded 2 '0' $ show mins) <> ":" - genSecs = fromString (padded 2 '0' $ show secs) - - genFract = - if fraction /= 0 - then fromText "." <> fromString (padded 7 '0' $ show fraction) - else mempty - --------------------------------------------------------------------------------- -interval :: Double -> Int64 -> TimeSpan -interval value scale = - let tmp = value * (realToFrac scale) - millis = tmp + (if value >= 0 then 0.5 else (-0.5)) - res = truncate (millis * (realToFrac ticksPerMillisecond)) in - TimeSpan res diff --git a/Database/EventStore/Internal/Types.hs b/Database/EventStore/Internal/Types.hs --- a/Database/EventStore/Internal/Types.hs +++ b/Database/EventStore/Internal/Types.hs @@ -37,6 +37,7 @@ -------------------------------------------------------------------------------- import qualified Data.Aeson as A import Data.Aeson.Types (Object, ToJSON(..), Pair, Parser, (.=)) +import Data.DotNet.TimeSpan import qualified Data.HashMap.Strict as H import Data.ProtocolBuffers import Data.Text (Text) @@ -46,7 +47,6 @@ -------------------------------------------------------------------------------- import Database.EventStore.Logging -import Database.EventStore.Internal.TimeSpan -------------------------------------------------------------------------------- -- Exceptions @@ -681,7 +681,7 @@ custPairs = customMetaToPairs streamMetadataCustom toInt64 :: TimeSpan -> Int64 - toInt64 = truncate . timeSpanTotalSeconds + toInt64 = truncate . totalSeconds -------------------------------------------------------------------------------- -- Stream ACL Properties @@ -790,7 +790,7 @@ parseTimeSpan :: Text -> Parser (Maybe TimeSpan) parseTimeSpan prop = do (secs :: Maybe Int64) <- m A..: prop - return $ fmap (timeSpanFromSeconds . realToFrac) secs + return $ fmap (fromSeconds . realToFrac) secs parseStreamMetadata _ = mzero -------------------------------------------------------------------------------- @@ -1011,12 +1011,12 @@ { psSettingsResolveLinkTos = False , psSettingsStartFrom = (-1) , psSettingsExtraStats = False - , psSettingsMsgTimeout = timeSpanFromSeconds 30 + , psSettingsMsgTimeout = fromSeconds 30 , psSettingsMaxRetryCount = 500 , psSettingsLiveBufSize = 500 , psSettingsReadBatchSize = 10 , psSettingsHistoryBufSize = 20 - , psSettingsCheckPointAfter = timeSpanFromSeconds 2 + , psSettingsCheckPointAfter = fromSeconds 2 , psSettingsMinCheckPointCount = 10 , psSettingsMaxCheckPointCount = 1000 , psSettingsMaxSubsCount = 0 diff --git a/eventstore.cabal b/eventstore.cabal --- a/eventstore.cabal +++ b/eventstore.cabal @@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.11.0.0 +version: 0.12.0.0 tested-with: GHC >= 7.8.3 && < 7.11 @@ -70,7 +70,6 @@ Database.EventStore.Internal.Packages Database.EventStore.Internal.Processor Database.EventStore.Internal.Stream - Database.EventStore.Internal.TimeSpan Database.EventStore.Internal.Types Database.EventStore.Internal.Manager.Operation.Model Database.EventStore.Internal.Manager.Subscription @@ -118,6 +117,7 @@ , dns , array , http-client + , dotnet-timespan -- Directories containing source files. -- hs-source-dirs: @@ -144,4 +144,5 @@ aeson, text, stm, - time + time, + dotnet-timespan diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -21,6 +21,7 @@ -------------------------------------------------------------------------------- import Data.Aeson +import Data.DotNet.TimeSpan import Test.Tasty import Test.Tasty.HUnit @@ -308,7 +309,7 @@ -------------------------------------------------------------------------------- maxAgeTest :: Connection -> IO () maxAgeTest conn = do - let timespan = timeSpanFromDays 1 + let timespan = fromDays 1 metadata = buildStreamMetadata $ setMaxAge timespan evt = createEvent "foo" Nothing $ withJson (object ["type" .= (3 :: Int)])