{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
module RON.Event (
CalendarTime (..),
Event (..),
Time (..),
TimeVariety (.., Calendar, Logical, Epoch, Unknown),
OriginVariety
(.., TrieForked, CryptoForked, RecordForked, ApplicationSpecific),
ReplicaClock (..),
Replica (..),
advanceToUuid,
decodeCalendar,
decodeEvent,
decodeReplica,
encodeCalendar,
encodeEvent,
getEvent,
getEventUuid,
getEventUuids,
mkCalendarDate,
mkCalendarDateTime,
mkCalendarDateTimeNano,
mkCalendarEvent,
mkReplica,
mkTime,
timeValue,
timeVariety,
) where
import RON.Prelude
import Data.Bits (shiftL, shiftR, (.&.), (.|.))
import qualified Data.ByteString.Char8 as BSC
import Data.Time (fromGregorianValid, makeTimeOfDayValid)
import qualified Text.Show
import RON.Base64 (encode60short)
import RON.Util.Word (pattern B00, pattern B01, pattern B10,
pattern B11, Word12, Word2, Word24, Word6,
Word60, leastSignificant12, leastSignificant2,
leastSignificant24, leastSignificant6, ls12,
ls24, ls6, ls60, safeCast)
import RON.UUID (UUID (..), UuidFields (..))
import qualified RON.UUID as UUID
data CalendarTime = CalendarTime
{ CalendarTime -> Word12
months :: Word12
, CalendarTime -> Word6
days :: Word6
, CalendarTime -> Word6
hours :: Word6
, CalendarTime -> Word6
minutes :: Word6
, CalendarTime -> Word6
seconds :: Word6
, CalendarTime -> Word24
nanosecHundreds :: Word24
}
deriving (CalendarTime -> CalendarTime -> Bool
(CalendarTime -> CalendarTime -> Bool)
-> (CalendarTime -> CalendarTime -> Bool) -> Eq CalendarTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CalendarTime -> CalendarTime -> Bool
$c/= :: CalendarTime -> CalendarTime -> Bool
== :: CalendarTime -> CalendarTime -> Bool
$c== :: CalendarTime -> CalendarTime -> Bool
Eq, Eq CalendarTime
Eq CalendarTime
-> (CalendarTime -> CalendarTime -> Ordering)
-> (CalendarTime -> CalendarTime -> Bool)
-> (CalendarTime -> CalendarTime -> Bool)
-> (CalendarTime -> CalendarTime -> Bool)
-> (CalendarTime -> CalendarTime -> Bool)
-> (CalendarTime -> CalendarTime -> CalendarTime)
-> (CalendarTime -> CalendarTime -> CalendarTime)
-> Ord CalendarTime
CalendarTime -> CalendarTime -> Bool
CalendarTime -> CalendarTime -> Ordering
CalendarTime -> CalendarTime -> CalendarTime
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CalendarTime -> CalendarTime -> CalendarTime
$cmin :: CalendarTime -> CalendarTime -> CalendarTime
max :: CalendarTime -> CalendarTime -> CalendarTime
$cmax :: CalendarTime -> CalendarTime -> CalendarTime
>= :: CalendarTime -> CalendarTime -> Bool
$c>= :: CalendarTime -> CalendarTime -> Bool
> :: CalendarTime -> CalendarTime -> Bool
$c> :: CalendarTime -> CalendarTime -> Bool
<= :: CalendarTime -> CalendarTime -> Bool
$c<= :: CalendarTime -> CalendarTime -> Bool
< :: CalendarTime -> CalendarTime -> Bool
$c< :: CalendarTime -> CalendarTime -> Bool
compare :: CalendarTime -> CalendarTime -> Ordering
$ccompare :: CalendarTime -> CalendarTime -> Ordering
$cp1Ord :: Eq CalendarTime
Ord, Int -> CalendarTime -> ShowS
[CalendarTime] -> ShowS
CalendarTime -> String
(Int -> CalendarTime -> ShowS)
-> (CalendarTime -> String)
-> ([CalendarTime] -> ShowS)
-> Show CalendarTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CalendarTime] -> ShowS
$cshowList :: [CalendarTime] -> ShowS
show :: CalendarTime -> String
$cshow :: CalendarTime -> String
showsPrec :: Int -> CalendarTime -> ShowS
$cshowsPrec :: Int -> CalendarTime -> ShowS
Show)
newtype TimeVariety = TimeVariety Word2
pattern Calendar :: TimeVariety
pattern $bCalendar :: TimeVariety
$mCalendar :: forall r. TimeVariety -> (Void# -> r) -> (Void# -> r) -> r
Calendar = TimeVariety B00
pattern Logical :: TimeVariety
pattern $bLogical :: TimeVariety
$mLogical :: forall r. TimeVariety -> (Void# -> r) -> (Void# -> r) -> r
Logical = TimeVariety B01
pattern Epoch :: TimeVariety
pattern $bEpoch :: TimeVariety
$mEpoch :: forall r. TimeVariety -> (Void# -> r) -> (Void# -> r) -> r
Epoch = TimeVariety B10
pattern Unknown :: TimeVariety
pattern $bUnknown :: TimeVariety
$mUnknown :: forall r. TimeVariety -> (Void# -> r) -> (Void# -> r) -> r
Unknown = TimeVariety B11
{-# COMPLETE Calendar, Logical, Epoch, Unknown #-}
instance Show TimeVariety where
show :: TimeVariety -> String
show = \case
TimeVariety
Calendar -> String
"Calendar"
TimeVariety
Logical -> String
"Logical"
TimeVariety
Epoch -> String
"Epoch"
TimeVariety
Unknown -> String
"Unknown"
newtype Time = Time Word64
deriving (Time -> Time -> Bool
(Time -> Time -> Bool) -> (Time -> Time -> Bool) -> Eq Time
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Time -> Time -> Bool
$c/= :: Time -> Time -> Bool
== :: Time -> Time -> Bool
$c== :: Time -> Time -> Bool
Eq, Eq Time
Eq Time
-> (Time -> Time -> Ordering)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Bool)
-> (Time -> Time -> Time)
-> (Time -> Time -> Time)
-> Ord Time
Time -> Time -> Bool
Time -> Time -> Ordering
Time -> Time -> Time
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Time -> Time -> Time
$cmin :: Time -> Time -> Time
max :: Time -> Time -> Time
$cmax :: Time -> Time -> Time
>= :: Time -> Time -> Bool
$c>= :: Time -> Time -> Bool
> :: Time -> Time -> Bool
$c> :: Time -> Time -> Bool
<= :: Time -> Time -> Bool
$c<= :: Time -> Time -> Bool
< :: Time -> Time -> Bool
$c< :: Time -> Time -> Bool
compare :: Time -> Time -> Ordering
$ccompare :: Time -> Time -> Ordering
$cp1Ord :: Eq Time
Ord)
instance Show Time where
show :: Time -> String
show Time
t =
TimeVariety -> String
forall a s. (Show a, IsString s) => a -> s
show (Time -> TimeVariety
timeVariety Time
t) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'/' Char -> ShowS
forall a. a -> [a] -> [a]
: ByteString -> String
BSC.unpack (Word60 -> ByteString
encode60short (Word60 -> ByteString) -> Word60 -> ByteString
forall a b. (a -> b) -> a -> b
$ Time -> Word60
timeValue Time
t)
timeVariety :: Time -> TimeVariety
timeVariety :: Time -> TimeVariety
timeVariety (Time Word64
w64) = Word2 -> TimeVariety
TimeVariety (Word2 -> TimeVariety) -> Word2 -> TimeVariety
forall a b. (a -> b) -> a -> b
$ Word64 -> Word2
forall integral. Integral integral => integral -> Word2
leastSignificant2 (Word64 -> Word2) -> Word64 -> Word2
forall a b. (a -> b) -> a -> b
$ Word64
w64 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
62
timeValue :: Time -> Word60
timeValue :: Time -> Word60
timeValue (Time Word64
w64) = Word64 -> Word60
ls60 Word64
w64
newtype OriginVariety = OriginVariety Word2
deriving newtype (Int -> OriginVariety -> Int
OriginVariety -> Int
(Int -> OriginVariety -> Int)
-> (OriginVariety -> Int) -> Hashable OriginVariety
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: OriginVariety -> Int
$chash :: OriginVariety -> Int
hashWithSalt :: Int -> OriginVariety -> Int
$chashWithSalt :: Int -> OriginVariety -> Int
Hashable)
pattern TrieForked :: OriginVariety
pattern $bTrieForked :: OriginVariety
$mTrieForked :: forall r. OriginVariety -> (Void# -> r) -> (Void# -> r) -> r
TrieForked = OriginVariety B00
pattern CryptoForked :: OriginVariety
pattern $bCryptoForked :: OriginVariety
$mCryptoForked :: forall r. OriginVariety -> (Void# -> r) -> (Void# -> r) -> r
CryptoForked = OriginVariety B01
pattern RecordForked :: OriginVariety
pattern $bRecordForked :: OriginVariety
$mRecordForked :: forall r. OriginVariety -> (Void# -> r) -> (Void# -> r) -> r
RecordForked = OriginVariety B10
pattern ApplicationSpecific :: OriginVariety
pattern $bApplicationSpecific :: OriginVariety
$mApplicationSpecific :: forall r. OriginVariety -> (Void# -> r) -> (Void# -> r) -> r
ApplicationSpecific = OriginVariety B11
{-# COMPLETE TrieForked, CryptoForked, RecordForked, ApplicationSpecific #-}
instance Show OriginVariety where
show :: OriginVariety -> String
show = \case
OriginVariety
TrieForked -> String
"Trie"
OriginVariety
CryptoForked -> String
"Crypto"
OriginVariety
RecordForked -> String
"Record"
OriginVariety
ApplicationSpecific -> String
"App"
newtype Replica = Replica Word64
deriving newtype (Replica -> Replica -> Bool
(Replica -> Replica -> Bool)
-> (Replica -> Replica -> Bool) -> Eq Replica
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Replica -> Replica -> Bool
$c/= :: Replica -> Replica -> Bool
== :: Replica -> Replica -> Bool
$c== :: Replica -> Replica -> Bool
Eq, Int -> Replica -> Int
Replica -> Int
(Int -> Replica -> Int) -> (Replica -> Int) -> Hashable Replica
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Replica -> Int
$chash :: Replica -> Int
hashWithSalt :: Int -> Replica -> Int
$chashWithSalt :: Int -> Replica -> Int
Hashable, Eq Replica
Eq Replica
-> (Replica -> Replica -> Ordering)
-> (Replica -> Replica -> Bool)
-> (Replica -> Replica -> Bool)
-> (Replica -> Replica -> Bool)
-> (Replica -> Replica -> Bool)
-> (Replica -> Replica -> Replica)
-> (Replica -> Replica -> Replica)
-> Ord Replica
Replica -> Replica -> Bool
Replica -> Replica -> Ordering
Replica -> Replica -> Replica
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Replica -> Replica -> Replica
$cmin :: Replica -> Replica -> Replica
max :: Replica -> Replica -> Replica
$cmax :: Replica -> Replica -> Replica
>= :: Replica -> Replica -> Bool
$c>= :: Replica -> Replica -> Bool
> :: Replica -> Replica -> Bool
$c> :: Replica -> Replica -> Bool
<= :: Replica -> Replica -> Bool
$c<= :: Replica -> Replica -> Bool
< :: Replica -> Replica -> Bool
$c< :: Replica -> Replica -> Bool
compare :: Replica -> Replica -> Ordering
$ccompare :: Replica -> Replica -> Ordering
$cp1Ord :: Eq Replica
Ord)
instance Show Replica where
show :: Replica -> String
show (Replica Word64
w64) =
OriginVariety -> String
forall a s. (Show a, IsString s) => a -> s
show (Word2 -> OriginVariety
OriginVariety (Word2 -> OriginVariety) -> Word2 -> OriginVariety
forall a b. (a -> b) -> a -> b
$ Word64 -> Word2
forall integral. Integral integral => integral -> Word2
leastSignificant2 (Word64 -> Word2) -> Word64 -> Word2
forall a b. (a -> b) -> a -> b
$ Word64
w64 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
60)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'/' Char -> ShowS
forall a. a -> [a] -> [a]
: ByteString -> String
BSC.unpack (Word60 -> ByteString
encode60short (Word60 -> ByteString) -> Word60 -> ByteString
forall a b. (a -> b) -> a -> b
$ Word64 -> Word60
ls60 Word64
w64)
data Event = Event
{ Event -> Time
time :: !Time
, Event -> Replica
replica :: !Replica
}
deriving (Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq, (forall x. Event -> Rep Event x)
-> (forall x. Rep Event x -> Event) -> Generic Event
forall x. Rep Event x -> Event
forall x. Event -> Rep Event x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Event x -> Event
$cfrom :: forall x. Event -> Rep Event x
Generic, Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show)
class Monad m => ReplicaClock m where
getPid :: m Replica
getEvents
:: Word60
-> m [Event]
advance :: Word60 -> m ()
instance ReplicaClock m => ReplicaClock (ExceptT e m) where
getPid :: ExceptT e m Replica
getPid = m Replica -> ExceptT e m Replica
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Replica
forall (m :: * -> *). ReplicaClock m => m Replica
getPid
getEvents :: Word60 -> ExceptT e m [Event]
getEvents = m [Event] -> ExceptT e m [Event]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Event] -> ExceptT e m [Event])
-> (Word60 -> m [Event]) -> Word60 -> ExceptT e m [Event]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word60 -> m [Event]
forall (m :: * -> *). ReplicaClock m => Word60 -> m [Event]
getEvents
advance :: Word60 -> ExceptT e m ()
advance = m () -> ExceptT e m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT e m ())
-> (Word60 -> m ()) -> Word60 -> ExceptT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word60 -> m ()
forall (m :: * -> *). ReplicaClock m => Word60 -> m ()
advance
instance ReplicaClock m => ReplicaClock (ReaderT r m) where
getPid :: ReaderT r m Replica
getPid = m Replica -> ReaderT r m Replica
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Replica
forall (m :: * -> *). ReplicaClock m => m Replica
getPid
getEvents :: Word60 -> ReaderT r m [Event]
getEvents = m [Event] -> ReaderT r m [Event]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Event] -> ReaderT r m [Event])
-> (Word60 -> m [Event]) -> Word60 -> ReaderT r m [Event]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word60 -> m [Event]
forall (m :: * -> *). ReplicaClock m => Word60 -> m [Event]
getEvents
advance :: Word60 -> ReaderT r m ()
advance = m () -> ReaderT r m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT r m ())
-> (Word60 -> m ()) -> Word60 -> ReaderT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word60 -> m ()
forall (m :: * -> *). ReplicaClock m => Word60 -> m ()
advance
instance ReplicaClock m => ReplicaClock (StateT s m) where
getPid :: StateT s m Replica
getPid = m Replica -> StateT s m Replica
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Replica
forall (m :: * -> *). ReplicaClock m => m Replica
getPid
getEvents :: Word60 -> StateT s m [Event]
getEvents = m [Event] -> StateT s m [Event]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Event] -> StateT s m [Event])
-> (Word60 -> m [Event]) -> Word60 -> StateT s m [Event]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word60 -> m [Event]
forall (m :: * -> *). ReplicaClock m => Word60 -> m [Event]
getEvents
advance :: Word60 -> StateT s m ()
advance = m () -> StateT s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT s m ())
-> (Word60 -> m ()) -> Word60 -> StateT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word60 -> m ()
forall (m :: * -> *). ReplicaClock m => Word60 -> m ()
advance
instance (Monoid s, ReplicaClock m) => ReplicaClock (WriterT s m) where
getPid :: WriterT s m Replica
getPid = m Replica -> WriterT s m Replica
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Replica
forall (m :: * -> *). ReplicaClock m => m Replica
getPid
getEvents :: Word60 -> WriterT s m [Event]
getEvents = m [Event] -> WriterT s m [Event]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Event] -> WriterT s m [Event])
-> (Word60 -> m [Event]) -> Word60 -> WriterT s m [Event]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word60 -> m [Event]
forall (m :: * -> *). ReplicaClock m => Word60 -> m [Event]
getEvents
advance :: Word60 -> WriterT s m ()
advance = m () -> WriterT s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WriterT s m ())
-> (Word60 -> m ()) -> Word60 -> WriterT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word60 -> m ()
forall (m :: * -> *). ReplicaClock m => Word60 -> m ()
advance
advanceToUuid :: ReplicaClock clock => UUID -> clock ()
advanceToUuid :: UUID -> clock ()
advanceToUuid UUID
uuid =
Bool -> clock () -> clock ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word2
uuidVariant Word2 -> Word2 -> Bool
forall a. Eq a => a -> a -> Bool
== Word2
B00 Bool -> Bool -> Bool
&& Word2
uuidVersion Word2 -> Word2 -> Bool
forall a. Eq a => a -> a -> Bool
== Word2
B10) (clock () -> clock ()) -> clock () -> clock ()
forall a b. (a -> b) -> a -> b
$ Word60 -> clock ()
forall (m :: * -> *). ReplicaClock m => Word60 -> m ()
advance Word60
uuidValue
where
UuidFields{Word60
uuidValue :: UuidFields -> Word60
uuidValue :: Word60
uuidValue, Word2
uuidVariant :: UuidFields -> Word2
uuidVariant :: Word2
uuidVariant, Word2
uuidVersion :: UuidFields -> Word2
uuidVersion :: Word2
uuidVersion} = UUID -> UuidFields
UUID.split UUID
uuid
getEvent :: (HasCallStack, ReplicaClock m) => m Event
getEvent :: m Event
getEvent = Word60 -> m [Event]
forall (m :: * -> *). ReplicaClock m => Word60 -> m [Event]
getEvents (Word64 -> Word60
ls60 Word64
1) m [Event] -> ([Event] -> m Event) -> m Event
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Event
e:[Event]
_ -> Event -> m Event
forall (f :: * -> *) a. Applicative f => a -> f a
pure Event
e
[] -> String -> m Event
forall a. HasCallStack => String -> a
error String
"getEvents returned no events"
getEventUuid :: ReplicaClock m => m UUID
getEventUuid :: m UUID
getEventUuid = Event -> UUID
encodeEvent (Event -> UUID) -> m Event -> m UUID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Event
forall (m :: * -> *). (HasCallStack, ReplicaClock m) => m Event
getEvent
getEventUuids :: ReplicaClock m => Word60 -> m [UUID]
getEventUuids :: Word60 -> m [UUID]
getEventUuids = ([Event] -> [UUID]) -> m [Event] -> m [UUID]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Event -> UUID) -> [Event] -> [UUID]
forall a b. (a -> b) -> [a] -> [b]
map Event -> UUID
encodeEvent) (m [Event] -> m [UUID])
-> (Word60 -> m [Event]) -> Word60 -> m [UUID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word60 -> m [Event]
forall (m :: * -> *). ReplicaClock m => Word60 -> m [Event]
getEvents
encodeCalendar :: CalendarTime -> Word60
encodeCalendar :: CalendarTime -> Word60
encodeCalendar CalendarTime{Word24
Word12
Word6
nanosecHundreds :: Word24
seconds :: Word6
minutes :: Word6
hours :: Word6
days :: Word6
months :: Word12
nanosecHundreds :: CalendarTime -> Word24
seconds :: CalendarTime -> Word6
minutes :: CalendarTime -> Word6
hours :: CalendarTime -> Word6
days :: CalendarTime -> Word6
months :: CalendarTime -> Word12
..} = Word64 -> Word60
ls60 (Word64 -> Word60) -> Word64 -> Word60
forall a b. (a -> b) -> a -> b
$
(Word12 -> Word64
forall v w. SafeCast v w => v -> w
safeCast Word12
months Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
48) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
(Word6 -> Word64
forall v w. SafeCast v w => v -> w
safeCast Word6
days Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
42) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
(Word6 -> Word64
forall v w. SafeCast v w => v -> w
safeCast Word6
hours Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
36) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
(Word6 -> Word64
forall v w. SafeCast v w => v -> w
safeCast Word6
minutes Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
30) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
(Word6 -> Word64
forall v w. SafeCast v w => v -> w
safeCast Word6
seconds Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
24) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|.
Word24 -> Word64
forall v w. SafeCast v w => v -> w
safeCast Word24
nanosecHundreds
decodeCalendar :: Word60 -> CalendarTime
decodeCalendar :: Word60 -> CalendarTime
decodeCalendar Word60
w = CalendarTime :: Word12
-> Word6 -> Word6 -> Word6 -> Word6 -> Word24 -> CalendarTime
CalendarTime
{ months :: Word12
months = Word64 -> Word12
forall integral. Integral integral => integral -> Word12
leastSignificant12 (Word64 -> Word12) -> Word64 -> Word12
forall a b. (a -> b) -> a -> b
$ Word64
v Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
48
, days :: Word6
days = Word64 -> Word6
forall integral. Integral integral => integral -> Word6
leastSignificant6 (Word64 -> Word6) -> Word64 -> Word6
forall a b. (a -> b) -> a -> b
$ Word64
v Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
42
, hours :: Word6
hours = Word64 -> Word6
forall integral. Integral integral => integral -> Word6
leastSignificant6 (Word64 -> Word6) -> Word64 -> Word6
forall a b. (a -> b) -> a -> b
$ Word64
v Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
36
, minutes :: Word6
minutes = Word64 -> Word6
forall integral. Integral integral => integral -> Word6
leastSignificant6 (Word64 -> Word6) -> Word64 -> Word6
forall a b. (a -> b) -> a -> b
$ Word64
v Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
30
, seconds :: Word6
seconds = Word64 -> Word6
forall integral. Integral integral => integral -> Word6
leastSignificant6 (Word64 -> Word6) -> Word64 -> Word6
forall a b. (a -> b) -> a -> b
$ Word64
v Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
24
, nanosecHundreds :: Word24
nanosecHundreds = Word64 -> Word24
forall integral. Integral integral => integral -> Word24
leastSignificant24 Word64
v
}
where
v :: Word64
v = Word60 -> Word64
forall v w. SafeCast v w => v -> w
safeCast Word60
w :: Word64
decodeTime :: Word64 -> Time
decodeTime :: Word64 -> Time
decodeTime Word64
value = Word64 -> Time
Time (Word64 -> Time) -> Word64 -> Time
forall a b. (a -> b) -> a -> b
$ Word64
value Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xCFFFFFFFFFFFFFFF
encodeEvent :: Event -> UUID
encodeEvent :: Event -> UUID
encodeEvent Event{Time
time :: Time
time :: Event -> Time
time, Replica
replica :: Replica
replica :: Event -> Replica
replica} =
Word64 -> Word64 -> UUID
UUID (Word64
varietyAndValue Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
originVariety) (Word64
eventVersion Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
origin)
where
Time Word64
varietyAndValue = Time
time
(Word64
originVariety, Word64
origin) = Replica -> (Word64, Word64)
encodeReplicaId Replica
replica
eventVersion :: Word64
eventVersion = Word64
0x2000000000000000
decodeEvent :: UUID -> Event
decodeEvent :: UUID -> Event
decodeEvent u :: UUID
u@(UUID Word64
x Word64
_) = Event :: Time -> Replica -> Event
Event{replica :: Replica
replica = UUID -> Replica
decodeReplica UUID
u, time :: Time
time = Word64 -> Time
decodeTime Word64
x}
decodeReplica :: UUID -> Replica
decodeReplica :: UUID -> Replica
decodeReplica (UUID Word64
x Word64
y) =
Word64 -> Replica
Replica (Word64 -> Replica) -> Word64 -> Replica
forall a b. (a -> b) -> a -> b
$ (Word64
x Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x3000000000000000) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word64
y Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x0FFFFFFFFFFFFFFF)
encodeReplicaId :: Replica -> (Word64, Word64)
encodeReplicaId :: Replica -> (Word64, Word64)
encodeReplicaId (Replica Word64
r) =
( Word64
r Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x3000000000000000
, Word64
r Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x0FFFFFFFFFFFFFFF
)
mkCalendarDate
:: (Word16, Word16, Word8)
-> Maybe CalendarTime
mkCalendarDate :: (Word16, Word16, Word8) -> Maybe CalendarTime
mkCalendarDate (Word16, Word16, Word8)
ymd = (Word16, Word16, Word8)
-> (Word8, Word8, Word8) -> Maybe CalendarTime
mkCalendarDateTime (Word16, Word16, Word8)
ymd (Word8
0, Word8
0, Word8
0)
mkCalendarDateTime
:: (Word16, Word16, Word8)
-> (Word8, Word8, Word8)
-> Maybe CalendarTime
mkCalendarDateTime :: (Word16, Word16, Word8)
-> (Word8, Word8, Word8) -> Maybe CalendarTime
mkCalendarDateTime (Word16, Word16, Word8)
ymd (Word8, Word8, Word8)
hms = (Word16, Word16, Word8)
-> (Word8, Word8, Word8) -> Word32 -> Maybe CalendarTime
mkCalendarDateTimeNano (Word16, Word16, Word8)
ymd (Word8, Word8, Word8)
hms Word32
0
mkCalendarDateTimeNano
:: (Word16, Word16, Word8)
-> (Word8, Word8, Word8)
-> Word32
-> Maybe CalendarTime
mkCalendarDateTimeNano :: (Word16, Word16, Word8)
-> (Word8, Word8, Word8) -> Word32 -> Maybe CalendarTime
mkCalendarDateTimeNano (Word16
y, Word16
m, Word8
d) (Word8
hh, Word8
mm, Word8
ss) Word32
hns = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Word16
y Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word16
2010
let months :: Word16
months = (Word16
y Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
2010) Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* Word16
12 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
m Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
1
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Word16
months Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
< Word16
4096
Day
_ <- Integer -> Int -> Int -> Maybe Day
fromGregorianValid (Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
y) (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
m) (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
d)
TimeOfDay
_ <-
Int -> Int -> Pico -> Maybe TimeOfDay
makeTimeOfDayValid (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
hh) (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
mm) (Word8 -> Pico
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
ss)
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Word32
hns Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
10000000
CalendarTime -> Maybe CalendarTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure CalendarTime :: Word12
-> Word6 -> Word6 -> Word6 -> Word6 -> Word24 -> CalendarTime
CalendarTime
{ months :: Word12
months = Word16 -> Word12
ls12 Word16
months
, days :: Word6
days = Word8 -> Word6
ls6 (Word8 -> Word6) -> Word8 -> Word6
forall a b. (a -> b) -> a -> b
$ Word8
d Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
1
, hours :: Word6
hours = Word8 -> Word6
ls6 Word8
hh
, minutes :: Word6
minutes = Word8 -> Word6
ls6 Word8
mm
, seconds :: Word6
seconds = Word8 -> Word6
ls6 Word8
ss
, nanosecHundreds :: Word24
nanosecHundreds = Word32 -> Word24
ls24 Word32
hns
}
mkReplica :: OriginVariety -> Word60 -> Replica
mkReplica :: OriginVariety -> Word60 -> Replica
mkReplica (OriginVariety Word2
variety) Word60
origin =
Word64 -> Replica
Replica (Word64 -> Replica) -> Word64 -> Replica
forall a b. (a -> b) -> a -> b
$ (Word2 -> Word64
forall v w. SafeCast v w => v -> w
safeCast Word2
variety Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
60) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word60 -> Word64
forall v w. SafeCast v w => v -> w
safeCast Word60
origin
mkTime :: TimeVariety -> Word60 -> Time
mkTime :: TimeVariety -> Word60 -> Time
mkTime (TimeVariety Word2
variety) Word60
value =
Word64 -> Time
Time (Word64 -> Time) -> Word64 -> Time
forall a b. (a -> b) -> a -> b
$ (Word2 -> Word64
forall v w. SafeCast v w => v -> w
safeCast Word2
variety Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
62) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word60 -> Word64
forall v w. SafeCast v w => v -> w
safeCast Word60
value
mkCalendarEvent :: CalendarTime -> Replica -> Event
mkCalendarEvent :: CalendarTime -> Replica -> Event
mkCalendarEvent CalendarTime
time Replica
replica =
Event :: Time -> Replica -> Event
Event{time :: Time
time = TimeVariety -> Word60 -> Time
mkTime TimeVariety
Calendar (Word60 -> Time) -> Word60 -> Time
forall a b. (a -> b) -> a -> b
$ CalendarTime -> Word60
encodeCalendar CalendarTime
time, Replica
replica :: Replica
replica :: Replica
replica}