diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -1,3 +1,7 @@ +0.7.2.1 +------- +* Fix compilation issue + 0.7.2.0 ------- * Add `setStreamMetadata` diff --git a/Database/EventStore.hs b/Database/EventStore.hs --- a/Database/EventStore.hs +++ b/Database/EventStore.hs @@ -460,7 +460,6 @@ Just s -> let res = StreamMetadataResult { streamMetaResultStream = stream - , streamMetaResultDeleted = False , streamMetaResultVersion = evt_number , streamMetaResultData = s } in diff --git a/Database/EventStore/Internal/TimeSpan.hs b/Database/EventStore/Internal/TimeSpan.hs new file mode 100644 --- /dev/null +++ b/Database/EventStore/Internal/TimeSpan.hs @@ -0,0 +1,257 @@ +{-# 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 +-- +-- Sorry but had no choice. +-------------------------------------------------------------------------------- +module Database.EventStore.Internal.TimeSpan + ( TimeSpan + , timeSpanTicks + , timeSpanHoursMinsSecs + , timeSpanDaysHoursMinsSecs + , timeSpanDaysHoursMinsSecsMillis + , timeSpanGetTicks + , timeSpanGetDays + , timeSpanGetHours + , timeSpanGetMinutes + , timeSpanGetSeconds + , timeSpanGetMillis + ) where + +-------------------------------------------------------------------------------- +import Control.Applicative +import Data.Int +import Data.Monoid +import Prelude + +-------------------------------------------------------------------------------- +import Data.Aeson +import Data.Attoparsec.Text +import Data.Text.Lazy (unpack) +import Data.Text.Lazy.Builder + +-------------------------------------------------------------------------------- +-- | .NET TimeSpan: TimeSpan represents a duration of time. A TimeSpan can be +-- negative or positive. Sorry +newtype TimeSpan = TimeSpan Int64 deriving (Eq, Ord) + +-------------------------------------------------------------------------------- +instance Show TimeSpan where + show = unpack . toLazyText . timeSpanBuilder + +-------------------------------------------------------------------------------- +instance ToJSON TimeSpan where + toJSON = toJSON . toLazyText . timeSpanBuilder + +-------------------------------------------------------------------------------- +instance FromJSON TimeSpan where + parseJSON (String s) = + case parseOnly parseTimeSpan s of + Left e -> fail e + Right ts -> return ts + parseJSON _ = empty + +-------------------------------------------------------------------------------- +parseFormatLiteral :: Parser FormatLiteral +parseFormatLiteral = do + c <- peekChar' + case c of + '-' -> fmap (const Negative) anyChar + _ -> return Positive + +-------------------------------------------------------------------------------- +parseDays :: Parser Int64 +parseDays = option 0 (decimal <* char '.') + +-------------------------------------------------------------------------------- +parseHours :: Parser Int64 +parseHours = decimal <* char ':' + +-------------------------------------------------------------------------------- +parseMinutes :: Parser Int64 +parseMinutes = parseHours + +-------------------------------------------------------------------------------- +parseSeconds :: Parser Int64 +parseSeconds = decimal + +-------------------------------------------------------------------------------- +parseMillis :: Parser Int64 +parseMillis = option 0 (char '.' >> decimal) + +-------------------------------------------------------------------------------- +parseBaseTimeSpan :: Parser TimeSpan +parseBaseTimeSpan = + timeSpanDaysHoursMinsSecsMillis <$> + parseDays <*> + parseHours <*> + parseMinutes <*> + parseSeconds <*> + parseMillis + +-------------------------------------------------------------------------------- +parseTimeSpan :: Parser TimeSpan +parseTimeSpan = do + lit <- parseFormatLiteral + ts@(TimeSpan i) <- parseBaseTimeSpan + case lit of + Negative -> return $ TimeSpan $ negate i + Positive -> return ts + +-------------------------------------------------------------------------------- +ticksPerMillisecond :: Int64 +ticksPerMillisecond = 10000 + +-------------------------------------------------------------------------------- +ticksPerSecond :: Int64 +ticksPerSecond = ticksPerMillisecond * 1000 + +-------------------------------------------------------------------------------- +ticksPerMinute :: Int64 +ticksPerMinute = ticksPerSecond * 60 + +-------------------------------------------------------------------------------- +ticksPerHour :: Int64 +ticksPerHour = ticksPerMinute * 60 + +-------------------------------------------------------------------------------- +ticksPerDay :: Int64 +ticksPerDay = ticksPerHour * 24 + +-------------------------------------------------------------------------------- +timeSpanTicks :: Int64 -> TimeSpan +timeSpanTicks = TimeSpan + +-------------------------------------------------------------------------------- +timeSpanHoursMinsSecs :: Int64 -> Int64 -> Int64 -> TimeSpan +timeSpanHoursMinsSecs hh mm ss = TimeSpan $ totalSecs * ticksPerSecond + where + totalSecs = (hh * 3600) + (mm * 60) + ss + +-------------------------------------------------------------------------------- +timeSpanDaysHoursMinsSecs :: Int64 -> Int64 -> Int64 -> Int64 -> TimeSpan +timeSpanDaysHoursMinsSecs dd hh mm ss = + timeSpanDaysHoursMinsSecsMillis dd hh mm ss 0 + +-------------------------------------------------------------------------------- +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 + +-------------------------------------------------------------------------------- +timeSpanGetTicks :: TimeSpan -> Int64 +timeSpanGetTicks (TimeSpan i) = i + +-------------------------------------------------------------------------------- +timeSpanGetDays :: TimeSpan -> Int64 +timeSpanGetDays (TimeSpan i) = truncate $ + (realToFrac i :: Double) / + (realToFrac ticksPerDay) + +-------------------------------------------------------------------------------- +timeSpanGetHours :: TimeSpan -> Int64 +timeSpanGetHours (TimeSpan i) = mod (truncate $ + (realToFrac i :: Double) / + (realToFrac ticksPerHour)) 24 + +-------------------------------------------------------------------------------- +timeSpanGetMinutes :: TimeSpan -> Int64 +timeSpanGetMinutes (TimeSpan i) = mod (truncate $ + (realToFrac i :: Double) / + (realToFrac ticksPerMinute)) 60 + +-------------------------------------------------------------------------------- +timeSpanGetSeconds :: TimeSpan -> Int64 +timeSpanGetSeconds (TimeSpan i) = mod (truncate $ + (realToFrac i :: Double) / + (realToFrac ticksPerSecond)) 60 + +-------------------------------------------------------------------------------- +timeSpanGetMillis :: TimeSpan -> Int64 +timeSpanGetMillis (TimeSpan i) = mod (truncate $ + (realToFrac i :: Double) / + (realToFrac ticksPerMillisecond)) 1000 + +-------------------------------------------------------------------------------- +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 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 @@ -951,8 +951,6 @@ = StreamMetadataResult { streamMetaResultStream :: !Text -- ^ The name of the stream. - , streamMetaResultDeleted :: !Bool - -- ^ True if the stream is soft-deleted. , streamMetaResultVersion :: !Int32 -- ^ The version of the metadata format. , streamMetaResultData :: !StreamMetadata @@ -961,5 +959,5 @@ | NotFoundStreamMetadataResult { streamMetaResultStream :: !Text } -- ^ When the stream is either not found or 'no stream'. | DeletedStreamMetadataResult { streamMetaResultStream :: !Text } - -- ^ When the stream is deleted. + -- ^ When the stream is soft-deleted. deriving Show 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.7.2.0 +version: 0.7.2.1 -- A short (one-line) description of the package. synopsis: EventStore TCP Client @@ -62,6 +62,7 @@ Database.EventStore.Internal.Packages Database.EventStore.Internal.Processor Database.EventStore.Internal.Reader + Database.EventStore.Internal.TimeSpan Database.EventStore.Internal.Types Database.EventStore.Internal.Manager.Operation Database.EventStore.Internal.Manager.Subscription