    {-
    Under BSD 3-Clause license, (c) 2009 Doug Beardsley <mightybyte@gmail.com>, (c) 2009-2012 Stephen Blackheath <http://blacksapphire.com/antispam/>, (c) 2009 Gregory Collins, (c) 2008 Evan Martin <martine@danga.com>, (c) 2009 Matthew Pocock <matthew.pocock@ncl.ac.uk>, (c) 2007-2009 Galois Inc., (c) 2010 Kevin Jardine, (c) 2012 Simon Hengel

    From https://hackage.haskell.org/package/hexpat-0.20.13
         https://github.com/the-real-blackh/hexpat/blob/master/Text/XML/Expat/SAX.hs#L227

    copied over because the upstream library doesn't expose this function.
    -}
    module Codec.Xlsx.Parser.Stream.HexpatInternal (parseBuf) where

    import Control.Monad
    import Text.XML.Expat.SAX
    import qualified Data.ByteString.Internal as I
    import Data.Bits
    import Data.Int
    import Data.ByteString.Internal (c_strlen)
    import Data.Word
    import Foreign.C
    import Foreign.ForeignPtr
    import Foreign.Ptr
    import Foreign.Storable

    {-# SCC parseBuf #-}
    parseBuf :: (GenericXMLString tag, GenericXMLString text) =>
                ForeignPtr Word8 -> CInt -> (Ptr Word8 -> Int -> IO (a, Int)) -> IO [(SAXEvent tag text, a)]
    parseBuf :: forall tag text a.
    (GenericXMLString tag, GenericXMLString text) =>
    ForeignPtr Word8
    -> CInt
    -> (Ptr Word8 -> Int -> IO (a, Int))
    -> IO [(SAXEvent tag text, a)]
    parseBuf ForeignPtr Word8
    buf CInt
    _ Ptr Word8 -> Int -> IO (a, Int)
    processExtra = ForeignPtr Word8
    -> (Ptr Word8 -> IO [(SAXEvent tag text, a)])
    -> IO [(SAXEvent tag text, a)]
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr ForeignPtr Word8
    buf ((Ptr Word8 -> IO [(SAXEvent tag text, a)])
     -> IO [(SAXEvent tag text, a)])
    -> (Ptr Word8 -> IO [(SAXEvent tag text, a)])
    -> IO [(SAXEvent tag text, a)]
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    pBuf -> [(SAXEvent tag text, a)]
    -> Ptr Word8 -> Int -> IO [(SAXEvent tag text, a)]
    forall {tag} {text}.
    (GenericXMLString tag, GenericXMLString text) =>
    [(SAXEvent tag text, a)]
    -> Ptr Word8 -> Int -> IO [(SAXEvent tag text, a)]
    doit [] Ptr Word8
    pBuf Int
    0
      where
        roundUp32 :: a -> a
    roundUp32 a
    offset = (a
    offset a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    3) a -> a -> a
    forall a. Bits a => a -> a -> a
    .&. a -> a
    forall a. Bits a => a -> a
    complement a
    3
        doit :: [(SAXEvent tag text, a)]
    -> Ptr Word8 -> Int -> IO [(SAXEvent tag text, a)]
    doit [(SAXEvent tag text, a)]
    acc Ptr Word8
    pBuf Int
    offset0 = Int
    offset0 Int -> IO [(SAXEvent tag text, a)] -> IO [(SAXEvent tag text, a)]
    forall a b. a -> b -> b
    `seq` do
            typ <- Ptr Word32 -> IO Word32
    forall a. Storable a => Ptr a -> IO a
    peek (Ptr Word8
    pBuf Ptr Word8 -> Int -> Ptr Word32
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    offset0 :: Ptr Word32)
            (a, offset) <- processExtra pBuf (offset0 + 4)
            case typ of
                Word32
    0 -> [(SAXEvent tag text, a)] -> IO [(SAXEvent tag text, a)]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(SAXEvent tag text, a)] -> [(SAXEvent tag text, a)]
    forall a. [a] -> [a]
    reverse [(SAXEvent tag text, a)]
    acc)
                Word32
    1 -> do
                    nAtts <- Ptr Word32 -> IO Word32
    forall a. Storable a => Ptr a -> IO a
    peek (Ptr Word8
    pBuf Ptr Word8 -> Int -> Ptr Word32
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    offset :: Ptr Word32)
                    let pName = Ptr Word8
    pBuf Ptr Word8 -> Int -> Ptr b
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` (Int
    offset Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    4)
                    lName <- fromIntegral <$> c_strlen pName
                    let name = ByteString -> tag
    forall s. GenericXMLString s => ByteString -> s
    gxFromByteString (ByteString -> tag) -> ByteString -> tag
    forall a b. (a -> b) -> a -> b
    $ ForeignPtr Word8 -> Int -> Int -> ByteString
    I.fromForeignPtr ForeignPtr Word8
    buf (Int
    offset Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    4) Int
    lName
                    (atts, offset') <- foldM (\([(tag, text)]
    atts, Int
    offset) Word32
    _ -> do
                            let pAtt :: Ptr b
    pAtt = Ptr Word8
    pBuf Ptr Word8 -> Int -> Ptr b
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    offset
                            lAtt <- CSize -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (CSize -> Int) -> IO CSize -> IO Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> CString -> IO CSize
    c_strlen CString
    forall {b}. Ptr b
    pAtt
                            let att = ByteString -> tag
    forall s. GenericXMLString s => ByteString -> s
    gxFromByteString (ByteString -> tag) -> ByteString -> tag
    forall a b. (a -> b) -> a -> b
    $ ForeignPtr Word8 -> Int -> Int -> ByteString
    I.fromForeignPtr ForeignPtr Word8
    buf Int
    offset Int
    lAtt
                                offset' = Int
    offset Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    lAtt Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
                                pValue = Ptr Word8
    pBuf Ptr Word8 -> Int -> Ptr b
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    offset'
                            lValue <- fromIntegral <$> c_strlen pValue
                            let value = ByteString -> text
    forall s. GenericXMLString s => ByteString -> s
    gxFromByteString (ByteString -> text) -> ByteString -> text
    forall a b. (a -> b) -> a -> b
    $ ForeignPtr Word8 -> Int -> Int -> ByteString
    I.fromForeignPtr ForeignPtr Word8
    buf Int
    offset' Int
    lValue
                            return ((att, value):atts, offset' + lValue + 1)
                        ) ([], offset + 4 + lName + 1) [1,3..nAtts]
                    doit ((StartElement name (reverse atts), a) : acc) pBuf (roundUp32 offset')
                Word32
    2 -> do
                    let pName :: Ptr b
    pName = Ptr Word8
    pBuf Ptr Word8 -> Int -> Ptr b
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    offset
                    lName <- CSize -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (CSize -> Int) -> IO CSize -> IO Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> CString -> IO CSize
    c_strlen CString
    forall {b}. Ptr b
    pName
                    let name = ByteString -> tag
    forall s. GenericXMLString s => ByteString -> s
    gxFromByteString (ByteString -> tag) -> ByteString -> tag
    forall a b. (a -> b) -> a -> b
    $ ForeignPtr Word8 -> Int -> Int -> ByteString
    I.fromForeignPtr ForeignPtr Word8
    buf Int
    offset Int
    lName
                        offset' = Int
    offset Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    lName Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
                    doit ((EndElement name, a) : acc) pBuf (roundUp32 offset')
                Word32
    3 -> do
                    len <- Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Int) -> IO Word32 -> IO Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Ptr Word32 -> IO Word32
    forall a. Storable a => Ptr a -> IO a
    peek (Ptr Word8
    pBuf Ptr Word8 -> Int -> Ptr Word32
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    offset :: Ptr Word32)
                    let text = ByteString -> text
    forall s. GenericXMLString s => ByteString -> s
    gxFromByteString (ByteString -> text) -> ByteString -> text
    forall a b. (a -> b) -> a -> b
    $ ForeignPtr Word8 -> Int -> Int -> ByteString
    I.fromForeignPtr ForeignPtr Word8
    buf (Int
    offset Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    4) Int
    len
                        offset' = Int
    offset Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    len
                    doit ((CharacterData text, a) : acc) pBuf (roundUp32 offset')
                Word32
    4 -> do
                    let pEnc :: Ptr b
    pEnc = Ptr Word8
    pBuf Ptr Word8 -> Int -> Ptr b
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    offset
                    lEnc <- CSize -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (CSize -> Int) -> IO CSize -> IO Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> CString -> IO CSize
    c_strlen CString
    forall {b}. Ptr b
    pEnc
                    let enc = ByteString -> text
    forall s. GenericXMLString s => ByteString -> s
    gxFromByteString (ByteString -> text) -> ByteString -> text
    forall a b. (a -> b) -> a -> b
    $ ForeignPtr Word8 -> Int -> Int -> ByteString
    I.fromForeignPtr ForeignPtr Word8
    buf Int
    offset Int
    lEnc
                        offset' = Int
    offset Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    lEnc Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
                        pVer = Ptr Word8
    pBuf Ptr Word8 -> Int -> Ptr b
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    offset'
                    pVerFirst <- peek (castPtr pVer :: Ptr Word8)
                    (mVer, offset'') <- case pVerFirst of
                        Word8
    0 -> (Maybe text, Int) -> IO (Maybe text, Int)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe text
    forall a. Maybe a
    Nothing, Int
    offset' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
                        Word8
    1 -> do
                            lVer <- CSize -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (CSize -> Int) -> IO CSize -> IO Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> CString -> IO CSize
    c_strlen (Ptr (ZonkAny 1)
    forall {b}. Ptr b
    pVer Ptr (ZonkAny 1) -> Int -> CString
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    1)
                            return (Just $ gxFromByteString $ I.fromForeignPtr buf (offset' + 1) lVer, offset' + 1 + lVer + 1)
                        Word8
    _ -> [Char] -> IO (Maybe text, Int)
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "hexpat: bad data from C land"
                    cSta <- peek (pBuf `plusPtr` offset'' :: Ptr Int8)
                    let sta = if Int8
    cSta Int8 -> Int8 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int8
    0  then Maybe Bool
    forall a. Maybe a
    Nothing else
                              if Int8
    cSta Int8 -> Int8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int8
    0 then Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False else
                                                Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    True
                    doit ((XMLDeclaration enc mVer sta, a) : acc) pBuf (roundUp32 (offset'' + 1))
                Word32
    5 -> [(SAXEvent tag text, a)]
    -> Ptr Word8 -> Int -> IO [(SAXEvent tag text, a)]
    doit ((SAXEvent tag text
    forall tag text. SAXEvent tag text
    StartCData, a
    a) (SAXEvent tag text, a)
    -> [(SAXEvent tag text, a)] -> [(SAXEvent tag text, a)]
    forall a. a -> [a] -> [a]
    : [(SAXEvent tag text, a)]
    acc) Ptr Word8
    pBuf Int
    offset
                Word32
    6 -> [(SAXEvent tag text, a)]
    -> Ptr Word8 -> Int -> IO [(SAXEvent tag text, a)]
    doit ((SAXEvent tag text
    forall tag text. SAXEvent tag text
    EndCData, a
    a) (SAXEvent tag text, a)
    -> [(SAXEvent tag text, a)] -> [(SAXEvent tag text, a)]
    forall a. a -> [a] -> [a]
    : [(SAXEvent tag text, a)]
    acc) Ptr Word8
    pBuf Int
    offset
                Word32
    7 -> do
                    let pTarget :: Ptr b
    pTarget = Ptr Word8
    pBuf Ptr Word8 -> Int -> Ptr b
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    offset
                    lTarget <- CSize -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (CSize -> Int) -> IO CSize -> IO Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> CString -> IO CSize
    c_strlen CString
    forall {b}. Ptr b
    pTarget
                    let target = ByteString -> text
    forall s. GenericXMLString s => ByteString -> s
    gxFromByteString (ByteString -> text) -> ByteString -> text
    forall a b. (a -> b) -> a -> b
    $ ForeignPtr Word8 -> Int -> Int -> ByteString
    I.fromForeignPtr ForeignPtr Word8
    buf Int
    offset Int
    lTarget
                        offset' = Int
    offset Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    lTarget Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
                        pData = Ptr Word8
    pBuf Ptr Word8 -> Int -> Ptr b
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    offset'
                    lData <- fromIntegral <$> c_strlen pData
                    let dat = ByteString -> text
    forall s. GenericXMLString s => ByteString -> s
    gxFromByteString (ByteString -> text) -> ByteString -> text
    forall a b. (a -> b) -> a -> b
    $ ForeignPtr Word8 -> Int -> Int -> ByteString
    I.fromForeignPtr ForeignPtr Word8
    buf Int
    offset' Int
    lData
                    doit ((ProcessingInstruction target dat, a) : acc) pBuf (roundUp32 (offset' + lData + 1))
                Word32
    8 -> do
                    let pText :: Ptr b
    pText = Ptr Word8
    pBuf Ptr Word8 -> Int -> Ptr b
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    offset
                    lText <- CSize -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (CSize -> Int) -> IO CSize -> IO Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> CString -> IO CSize
    c_strlen CString
    forall {b}. Ptr b
    pText
                    let text = ByteString -> text
    forall s. GenericXMLString s => ByteString -> s
    gxFromByteString (ByteString -> text) -> ByteString -> text
    forall a b. (a -> b) -> a -> b
    $ ForeignPtr Word8 -> Int -> Int -> ByteString
    I.fromForeignPtr ForeignPtr Word8
    buf Int
    offset Int
    lText
                    doit ((Comment text, a) : acc) pBuf (roundUp32 (offset + lText + 1))
                Word32
    _ -> [Char] -> IO [(SAXEvent tag text, a)]
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "hexpat: bad data from C land"