module Database.PostgreSQL.Replicant.Types.Lsn where
import Data.Aeson
import Data.Attoparsec.ByteString.Char8
import Data.Bits
import Data.Bits.Extras
import Data.ByteString (ByteString ())
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Builder as Builder
import Data.ByteString.Lazy.Builder.ASCII (word32Hex)
import Data.Serialize
import Data.Word
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import GHC.Int
data LSN = LSN
{ LSN -> Int32
filepart :: !Int32
, LSN -> Int32
offset :: !Int32
}
deriving (Int -> LSN -> ShowS
[LSN] -> ShowS
LSN -> String
(Int -> LSN -> ShowS)
-> (LSN -> String) -> ([LSN] -> ShowS) -> Show LSN
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LSN] -> ShowS
$cshowList :: [LSN] -> ShowS
show :: LSN -> String
$cshow :: LSN -> String
showsPrec :: Int -> LSN -> ShowS
$cshowsPrec :: Int -> LSN -> ShowS
Show, LSN -> LSN -> Bool
(LSN -> LSN -> Bool) -> (LSN -> LSN -> Bool) -> Eq LSN
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LSN -> LSN -> Bool
$c/= :: LSN -> LSN -> Bool
== :: LSN -> LSN -> Bool
$c== :: LSN -> LSN -> Bool
Eq)
instance Ord LSN where
compare :: LSN -> LSN -> Ordering
compare (LSN Int32
l0 Int32
r0) (LSN Int32
l1 Int32
r1) =
Int32 -> Int32 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int32
l0 Int32
l1 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Int32 -> Int32 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int32
r0 Int32
r1
instance Serialize LSN where
put :: Putter LSN
put = Putter Int64
putInt64be Putter Int64 -> (LSN -> Int64) -> Putter LSN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LSN -> Int64
toInt64
get :: Get LSN
get = Int64 -> LSN
fromInt64 (Int64 -> LSN) -> Get Int64 -> Get LSN
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
getInt64be
instance ToJSON LSN where
toJSON :: LSN -> Value
toJSON = Text -> Value
String (Text -> Value) -> (LSN -> Text) -> LSN -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toUpper (Text -> Text) -> (LSN -> Text) -> LSN -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> (LSN -> ByteString) -> LSN -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LSN -> ByteString
toByteString
instance FromJSON LSN where
parseJSON :: Value -> Parser LSN
parseJSON = String -> (Text -> Parser LSN) -> Value -> Parser LSN
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"LSN" ((Text -> Parser LSN) -> Value -> Parser LSN)
-> (Text -> Parser LSN) -> Value -> Parser LSN
forall a b. (a -> b) -> a -> b
$ \Text
txt ->
case ByteString -> Either String LSN
fromByteString (ByteString -> Either String LSN)
-> (Text -> ByteString) -> Text -> Either String LSN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> Either String LSN) -> Text -> Either String LSN
forall a b. (a -> b) -> a -> b
$ Text
txt of
Left String
err -> String -> Parser LSN
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
Right LSN
lsn -> LSN -> Parser LSN
forall (f :: * -> *) a. Applicative f => a -> f a
pure LSN
lsn
toInt64 :: LSN -> Int64
toInt64 :: LSN -> Int64
toInt64 (LSN Int32
filePart Int32
offSet) =
let r :: Word64
r = Int32 -> Word64
forall a. Integral a => a -> Word64
w64 Int32
filePart Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32
in Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> Word64 -> Int64
forall a b. (a -> b) -> a -> b
$ Word64
r Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Int32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
offSet
fromInt64 :: Int64 -> LSN
fromInt64 :: Int64 -> LSN
fromInt64 Int64
x =
let mask :: Word64
mask = Word32 -> Word64
forall a. Integral a => a -> Word64
w64 (Word32 -> Word64) -> Word32 -> Word64
forall a b. (a -> b) -> a -> b
$ Bounded Word32 => Word32
forall a. Bounded a => a
maxBound @Word32
offSet :: Int32
offSet = Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int32) -> (Word64 -> Word32) -> Word64 -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word32
forall a. Integral a => a -> Word32
w32 (Word64 -> Int32) -> Word64 -> Int32
forall a b. (a -> b) -> a -> b
$ Word64
mask Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x
filePart :: Int32
filePart = Int64 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int32) -> Int64 -> Int32
forall a b. (a -> b) -> a -> b
$ Int64
x Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32
in Int32 -> Int32 -> LSN
LSN Int32
filePart Int32
offSet
lsnParser :: Parser LSN
lsnParser :: Parser LSN
lsnParser = Int32 -> Int32 -> LSN
LSN (Int32 -> Int32 -> LSN)
-> Parser ByteString Int32 -> Parser ByteString (Int32 -> LSN)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ByteString Int32
forall a. (Integral a, Bits a) => Parser a
hexadecimal Parser ByteString Int32
-> Parser ByteString Char -> Parser ByteString Int32
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
char Char
'/') Parser ByteString (Int32 -> LSN)
-> Parser ByteString Int32 -> Parser LSN
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString Int32
forall a. (Integral a, Bits a) => Parser a
hexadecimal
fromByteString :: ByteString -> Either String LSN
fromByteString :: ByteString -> Either String LSN
fromByteString = Parser LSN -> ByteString -> Either String LSN
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser LSN
lsnParser
toByteString :: LSN -> ByteString
toByteString :: LSN -> ByteString
toByteString (LSN Int32
filepart Int32
off) = ByteString -> ByteString
BL.toStrict
(ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
Builder.toLazyByteString
( Word32 -> Builder
word32Hex (Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
filepart)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Builder.char7 Char
'/'
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
word32Hex (Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
off)
)
add :: LSN -> Int64 -> LSN
add :: LSN -> Int64 -> LSN
add LSN
lsn Int64
bytes = Int64 -> LSN
fromInt64 (Int64 -> LSN) -> (LSN -> Int64) -> LSN -> LSN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
bytes) (Int64 -> Int64) -> (LSN -> Int64) -> LSN -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LSN -> Int64
toInt64 (LSN -> LSN) -> LSN -> LSN
forall a b. (a -> b) -> a -> b
$ LSN
lsn
sub :: LSN -> Int64 -> LSN
sub :: LSN -> Int64 -> LSN
sub LSN
lsn Int64
bytes = Int64 -> LSN
fromInt64 (Int64 -> LSN) -> (LSN -> Int64) -> LSN -> LSN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64 -> Int64 -> Int64) -> Int64 -> Int64 -> Int64
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-) Int64
bytes (Int64 -> Int64) -> (LSN -> Int64) -> LSN -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LSN -> Int64
toInt64 (LSN -> LSN) -> LSN -> LSN
forall a b. (a -> b) -> a -> b
$ LSN
lsn
subLsn :: LSN -> LSN -> Int64
subLsn :: LSN -> LSN -> Int64
subLsn LSN
lsn1 LSN
lsn2 = LSN -> Int64
toInt64 LSN
lsn1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- LSN -> Int64
toInt64 LSN
lsn2