module Binrep.BLen.Internal.AsBLen where

import GHC.Natural ( minusNaturalMaybe )
import GHC.Num.Natural
import GHC.Exts
import Binrep.Util ( posIntToNat )

-- | Helper definitions for using the given type to store byte lengths.
--
-- Byte lengths must be non-negative. Thus, the ideal representation is a
-- 'Natural'. However, most underlying types that we use ('B.ByteString', lists)
-- store their length in 'Int's. By similarly storing an 'Int' ourselves, we
-- could potentially improve performance.
--
-- I like both options, and don't want to give up either. So we provide helpers
-- via a typeclass so that the user doesn't ever have to think about the
-- underlying type.
--
-- For simplicity, documentation may consider 'a' to be an "unsigned" type. For
-- example, underflow refers to a negative 'a' result.
class AsBLen a where
    -- | Safe blen subtraction, returning 'Nothing' for negative results.
    --
    -- Regular subtraction should only be used when you have a guarantee that it
    -- won't underflow.
    safeBLenSub :: a -> a -> Maybe a

    -- | Convert some 'Int' @i@ where @i >= 0@ to a blen.
    --
    -- This is intended for wrapping the output of 'length' functions.
    posIntToBLen :: Int -> a

    -- | Convert some 'Word#' @w@ where @w <= maxBound @a@ to a blen.
    wordToBLen# :: Word# -> a

    -- | Convert some 'Natural' @n@ where @n <= maxBound @a@ to a blen.
    natToBLen :: Natural -> a

instance AsBLen Int where
    safeBLenSub :: Int -> Int -> Maybe Int
safeBLenSub Int
x Int
y = if Int
z forall a. Ord a => a -> a -> Bool
>= Int
0 then forall a. a -> Maybe a
Just Int
z else forall a. Maybe a
Nothing where z :: Int
z = Int
x forall a. Num a => a -> a -> a
- Int
y
    {-# INLINE safeBLenSub #-}

    posIntToBLen :: Int -> Int
posIntToBLen = forall a. a -> a
id
    {-# INLINE posIntToBLen #-}

    natToBLen :: Natural -> Int
natToBLen = \case
      NS Word#
w# -> forall a. AsBLen a => Word# -> a
wordToBLen# Word#
w#
      NB ByteArray#
_  -> forall a. HasCallStack => [Char] -> a
error [Char]
"TODO natural too large"
    {-# INLINE natToBLen #-}

    wordToBLen# :: Word# -> Int
wordToBLen# Word#
w# = Int# -> Int
I# (Word# -> Int#
word2Int# Word#
w#)
    {-# INLINE wordToBLen# #-}

instance AsBLen Natural where
    safeBLenSub :: Natural -> Natural -> Maybe Natural
safeBLenSub = Natural -> Natural -> Maybe Natural
minusNaturalMaybe
    {-# INLINE safeBLenSub #-}

    posIntToBLen :: Int -> Natural
posIntToBLen = Int -> Natural
posIntToNat
    {-# INLINE posIntToBLen #-}

    wordToBLen# :: Word# -> Natural
wordToBLen# = Word# -> Natural
NS
    {-# INLINE wordToBLen# #-}

    natToBLen :: Natural -> Natural
natToBLen = forall a. a -> a
id
    {-# INLINE natToBLen #-}