    {-# LANGUAGE MagicHash, UnboxedTuples, BangPatterns, CPP #-}
    {-# OPTIONS_HADDOCK hide #-}

    module Codec.Archive.Tar.Index.Utils where

    import Data.ByteString as BS
    import Control.Exception (assert)

    import Data.ByteString.Internal (ByteString(..), unsafeWithForeignPtr, accursedUnutterablePerformIO)
    import GHC.Int (Int(..), Int32)
    import GHC.Word (Word32(..), byteSwap32)
    import Foreign.Storable (peek)
    import GHC.Ptr (castPtr, plusPtr, Ptr)
    import GHC.Exts
    import GHC.IO (IO(..), unsafePerformIO)
    import Data.Array.Base
    import Data.Array.IO.Internals (unsafeFreezeIOUArray)
    import Control.DeepSeq (NFData(..))
    import GHC.Storable
    import GHC.ByteOrder

    #include <MachDeps.h>

    -- | Construct a `UArray Word32 Word32` from a ByteString of 32bit big endian
    -- words.
    --
    -- Note: If using `unsafePerformIO`, be sure to force the result of running the
    -- IO action right away... (e.g. see calls to beToLe in StringTable)
    beToLe :: (Integral i, Num i) => i
           -- ^ The total array length (the number of 32bit words in the array)
           -> BS.ByteString
           -- ^ The bytestring from which the UArray is constructed.
           -- The content must start in the first byte! (i.e. the meta-data words
           -- that shouldn't be part of the array, must have been dropped already)
           -> IO (UArray i Word32)
    beToLe :: forall i.
    (Integral i, Num i) =>
    i -> ByteString -> IO (UArray i Word32)
    beToLe i
    lenArr (BS ForeignPtr Word8
    fptr Int
    _) = do
      ForeignPtr Word8
    -> (Ptr Word8 -> IO (UArray i Word32)) -> IO (UArray i Word32)
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    unsafeWithForeignPtr ForeignPtr Word8
    fptr ((Ptr Word8 -> IO (UArray i Word32)) -> IO (UArray i Word32))
    -> (Ptr Word8 -> IO (UArray i Word32)) -> IO (UArray i Word32)
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    ptr -> do
        let ptr' :: Ptr Word32
    ptr' = Ptr Word8 -> Ptr Word32
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Word8
    ptr :: Ptr Word32
            !(I# Int#
    lenBytes#) = i -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (i
    lenArr i -> i -> i
    forall a. Num a => a -> a -> a
    * i
    4)

        -- In spirit, the following does this, but we can't use `newGenArray`
        -- because it only has been introduced in later versions of array:
        -- @@
        -- unsafeFreezeIOUArray =<<
        --   newGenArray (0, lenArr - 1) (\offset -> do
        --     byteSwap32 <$> peek (ptr' `plusPtr` (fromIntegral offset * 4)))
        -- @@
        (State# RealWorld -> (# State# RealWorld, UArray i Word32 #))
    -> IO (UArray i Word32)
    forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
    IO ((State# RealWorld -> (# State# RealWorld, UArray i Word32 #))
     -> IO (UArray i Word32))
    -> (State# RealWorld -> (# State# RealWorld, UArray i Word32 #))
    -> IO (UArray i Word32)
    forall a b. (a -> b) -> a -> b
    $ \State# RealWorld
    rw0 ->
          case Int#
    -> State# RealWorld
    -> (# State# RealWorld, MutableByteArray# RealWorld #)
    forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
    newByteArray# Int#
    lenBytes# State# RealWorld
    rw0 of
            (# State# RealWorld
    rw1, MutableByteArray# RealWorld
    mba# #) ->

              let loop :: Int -> State# RealWorld -> State# RealWorld
                  loop :: Int -> State# RealWorld -> State# RealWorld
    loop !Int
    offset State# RealWorld
    st
                    | Int
    offset Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < i -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral i
    lenArr
                    = let IO State# RealWorld -> (# State# RealWorld, Word32 #)
    getV = Ptr Word32 -> Int -> IO Word32
    readWord32OffPtrBE Ptr Word32
    ptr' Int
    offset
                          !(I# Int#
    o#) = Int
    offset
                       in case State# RealWorld -> (# State# RealWorld, Word32 #)
    getV State# RealWorld
    st of
                        (# State# RealWorld
    st', W32# Word32#
    v# #) ->
                          Int -> State# RealWorld -> State# RealWorld
    loop (Int
    offset Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (MutableByteArray# RealWorld
    -> Int# -> Word32# -> State# RealWorld -> State# RealWorld
    forall d.
    MutableByteArray# d -> Int# -> Word32# -> State# d -> State# d
    writeWord32Array# MutableByteArray# RealWorld
    mba# Int#
    o# Word32#
    v# State# RealWorld
    st')
                    | Bool
    otherwise = State# RealWorld
    st

               in case MutableByteArray# RealWorld
    -> State# RealWorld -> (# State# RealWorld, ByteArray# #)
    forall d.
    MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
    unsafeFreezeByteArray# MutableByteArray# RealWorld
    mba# (Int -> State# RealWorld -> State# RealWorld
    loop Int
    0 State# RealWorld
    rw1) of
                 (# State# RealWorld
    rw2, ByteArray#
    ba# #) -> (# State# RealWorld
    rw2, i -> i -> Int -> ByteArray# -> UArray i Word32
    forall i e. i -> i -> Int -> ByteArray# -> UArray i e
    UArray i
    0 (i
    lenArr i -> i -> i
    forall a. Num a => a -> a -> a
    - i
    1) (i -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral i
    lenArr) ByteArray#
    ba# #)

    {-# SPECIALISE beToLe :: Word32 -> BS.ByteString -> IO (UArray Word32 Word32) #-}
    {-# SPECIALISE beToLe :: Int32 -> BS.ByteString -> IO (UArray Int32 Word32) #-}

    readInt32BE :: BS.ByteString -> Int -> Int32
    readInt32BE :: ByteString -> Int -> Int32
    readInt32BE ByteString
    bs Int
    i = Word32 -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (ByteString -> Int -> Word32
    readWord32BE ByteString
    bs Int
    i)
    {-# INLINE readInt32BE #-}

    readWord32OffPtrBE :: Ptr Word32 -> Int -> IO Word32
    readWord32OffPtrBE :: Ptr Word32 -> Int -> IO Word32
    readWord32OffPtrBE Ptr Word32
    ptr Int
    i = do
    #if defined(WORDS_BIGENDIAN)
      readWord32OffPtr ptr i
    #else
      Word32 -> Word32
    byteSwap32 (Word32 -> Word32) -> IO Word32 -> IO Word32
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Ptr Word32 -> Int -> IO Word32
    readWord32OffPtr Ptr Word32
    ptr Int
    i
    #endif

    readWord32BE :: BS.ByteString -> Int -> Word32
    readWord32BE :: ByteString -> Int -> Word32
    readWord32BE (BS ForeignPtr Word8
    fptr Int
    len) Int
    i =
        Bool -> Word32 -> Word32
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    0 Bool -> Bool -> Bool
    && Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    3 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) (Word32 -> Word32) -> Word32 -> Word32
    forall a b. (a -> b) -> a -> b
    $
        IO Word32 -> Word32
    forall a. IO a -> a
    accursedUnutterablePerformIO (IO Word32 -> Word32) -> IO Word32 -> Word32
    forall a b. (a -> b) -> a -> b
    $
          ForeignPtr Word8 -> (Ptr Word8 -> IO Word32) -> IO Word32
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    unsafeWithForeignPtr ForeignPtr Word8
    fptr ((Ptr Word8 -> IO Word32) -> IO Word32)
    -> (Ptr Word8 -> IO Word32) -> IO Word32
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    ptr -> do
            Ptr Word32 -> Int -> IO Word32
    readWord32OffPtrBE (Ptr Word8 -> Ptr Word32
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Word8
    ptr) Int
    i
    {-# INLINE readWord32BE #-}