{-# LANGUAGE CPP       #-}
{-# LANGUAGE MagicHash #-}
{-# OPTIONS_HADDOCK not-home #-}

module Database.LSMTree.Internal.Assertions (
    assert,
    isValidSlice,
    sameByteArray,
    fromIntegralChecked,
) where

#if MIN_VERSION_base(4,17,0)
import           GHC.Exts (isTrue#, sameByteArray#)
#else
import           GHC.Exts (ByteArray#, MutableByteArray#, isTrue#,
                     sameMutableByteArray#, unsafeCoerce#)
#endif

import           Control.Exception (assert)
import           Data.Primitive.ByteArray (ByteArray (..), sizeofByteArray)
import           GHC.Stack (HasCallStack)
import           Text.Printf

isValidSlice :: Int -> Int -> ByteArray -> Bool
isValidSlice :: Int -> Int -> ByteArray -> Bool
isValidSlice Int
off Int
len ByteArray
ba =
    Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&&
    Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&&
    (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& -- sum doesn't overflow
    (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteArray -> Int
sizeofByteArray ByteArray
ba

sameByteArray :: ByteArray -> ByteArray -> Bool
sameByteArray :: ByteArray -> ByteArray -> Bool
sameByteArray (ByteArray ByteArray#
ba1#) (ByteArray ByteArray#
ba2#) =
#if MIN_VERSION_base(4,17,0)
    Int# -> Bool
isTrue# (ByteArray# -> ByteArray# -> Int#
sameByteArray# ByteArray#
ba1# ByteArray#
ba2#)
#else
    isTrue# (sameMutableByteArray# (unsafeCoerceByteArray# ba1#)
                                   (unsafeCoerceByteArray# ba2#))
  where
    unsafeCoerceByteArray# :: ByteArray# -> MutableByteArray# s
    unsafeCoerceByteArray# = unsafeCoerce#
#endif

{-# INLINABLE fromIntegralChecked #-}
-- | Like 'fromIntegral', but throws an error when @(x :: a) /= fromIntegral
-- (fromIntegral x :: b)@.
fromIntegralChecked :: (HasCallStack, Integral a, Integral b, Show a) => a -> b
fromIntegralChecked :: forall a b.
(HasCallStack, Integral a, Integral b, Show a) =>
a -> b
fromIntegralChecked a
x
  | a
x'' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x
  = b
x'
  | Bool
otherwise
  = String -> b
forall a. HasCallStack => String -> a
error (String -> b) -> String -> b
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"fromIntegralChecked: conversion failed, %s /= %s" (a -> String
forall a. Show a => a -> String
show a
x) (a -> String
forall a. Show a => a -> String
show a
x'')
  where
    x' :: b
x' = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x
    x'' :: a
x'' = b -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
x'