{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- | DOM parser and API for XML.

module Xeno.DOM
  ( parse
  , Node
  , Content(..)
  , name
  , attributes
  , contents
  , children
  ) where

import           Control.Monad.ST
import           Control.Spork
import           Data.ByteString          (ByteString)
import           Data.ByteString.Internal (ByteString(PS))
import qualified Data.ByteString as S
import           Data.Mutable
import           Data.STRef
import qualified Data.Vector.Unboxed as UV
import qualified Data.Vector.Unboxed.Mutable as UMV
import           Xeno.SAX
import           Xeno.Types
import           Xeno.DOM.Internal

-- | Parse a complete Nodes document.
parse :: ByteString -> Either XenoException Node
parse :: ByteString -> Either XenoException Node
parse ByteString
str =
  Either XenoException Node
-> (Node -> Either XenoException Node)
-> Maybe Node
-> Either XenoException Node
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (XenoException -> Either XenoException Node
forall a b. a -> Either a b
Left XenoException
XenoExpectRootNode) Node -> Either XenoException Node
forall a b. b -> Either a b
Right (Maybe Node -> Either XenoException Node)
-> (Vector Int -> Maybe Node)
-> Vector Int
-> Either XenoException Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Int -> Maybe Node
findRootNode (Vector Int -> Either XenoException Node)
-> Either XenoException (Vector Int) -> Either XenoException Node
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Vector Int -> Either XenoException (Vector Int)
forall e a. Exception e => a -> Either e a
spork Vector Int
node
  where
    findRootNode :: Vector Int -> Maybe Node
findRootNode Vector Int
r = Int -> Maybe Node
go Int
0
      where
        go :: Int -> Maybe Node
go Int
n = case Vector Int
r Vector Int -> Int -> Maybe Int
forall a. Unbox a => Vector a -> Int -> Maybe a
UV.!? Int
n of
          Just Int
0x0 -> Node -> Maybe Node
forall a. a -> Maybe a
Just (ByteString -> Int -> Vector Int -> Node
Node ByteString
str Int
n Vector Int
r)
          -- skipping text assuming that it contains only white space
          -- characters
          Just Int
0x1 -> Int -> Maybe Node
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3)
          Maybe Int
_        -> Maybe Node
forall a. Maybe a
Nothing
    PS ForeignPtr Word8
_ Int
offset0 Int
_ = ByteString
str
    node :: Vector Int
node =
      let !initialSize :: Int
initialSize = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1000 (ByteString -> Int
S.length ByteString
str Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8) in
      (forall s. ST s (Vector Int)) -> Vector Int
forall a. (forall s. ST s a) -> a
runST
        (do MVector s Int
nil <- Int -> ST s (MVector (PrimState (ST s)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
UMV.unsafeNew Int
initialSize
            STRef s (MVector s Int)
vecRef <- MVector s Int -> ST s (STRef s (MVector s Int))
forall a s. a -> ST s (STRef s a)
newSTRef MVector s Int
nil
            URef s Int
sizeRef <- (URef s Int -> URef s Int)
-> ST s (URef s Int) -> ST s (URef s Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap URef s Int -> URef s Int
forall s a. URef s a -> URef s a
asURef (RefElement (URef s Int) -> ST s (URef s Int)
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
RefElement c -> m c
newRef RefElement (URef s Int)
0)
            URef s Int
parentRef <- (URef s Int -> URef s Int)
-> ST s (URef s Int) -> ST s (URef s Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap URef s Int -> URef s Int
forall s a. URef s a -> URef s a
asURef (RefElement (URef s Int) -> ST s (URef s Int)
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
RefElement c -> m c
newRef RefElement (URef s Int)
0)
            Process (ST s ()) -> ByteString -> ST s ()
forall (m :: * -> *) str.
(Monad m, StringLike str) =>
Process (m ()) -> str -> m ()
process Process :: forall a.
(ByteString -> a)
-> (ByteString -> ByteString -> a)
-> (ByteString -> a)
-> (ByteString -> a)
-> (ByteString -> a)
-> (ByteString -> a)
-> Process a
Process {
                openF :: ByteString -> ST s ()
openF = \(PS ForeignPtr Word8
_ Int
name_start Int
name_len) -> do
                     let tag :: Int
tag = Int
0x00
                         tag_end :: Int
tag_end = -Int
1
                     Int
index <- URef s Int -> ST s (RefElement (URef s Int))
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> m (RefElement c)
readRef URef s Int
sizeRef
                     MVector s Int
v' <-
                       do MVector s Int
v <- STRef s (MVector s Int) -> ST s (MVector s Int)
forall s a. STRef s a -> ST s a
readSTRef STRef s (MVector s Int)
vecRef
                          if Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< MVector s Int -> Int
forall a s. Unbox a => MVector s a -> Int
UMV.length MVector s Int
v
                            then MVector s Int -> ST s (MVector s Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure MVector s Int
v
                            else do
                              MVector s Int
v' <- MVector (PrimState (ST s)) Int
-> Int -> ST s (MVector (PrimState (ST s)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
UMV.unsafeGrow MVector s Int
MVector (PrimState (ST s)) Int
v (Int -> Int -> Int -> Int -> Int
forall b a. (Integral b, Integral a) => Int -> Int -> a -> b -> b
predictGrowSize Int
name_start Int
name_len (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5) (MVector s Int -> Int
forall a s. Unbox a => MVector s a -> Int
UMV.length MVector s Int
v))
                              STRef s (MVector s Int) -> MVector s Int -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (MVector s Int)
vecRef MVector s Int
v'
                              MVector s Int -> ST s (MVector s Int)
forall (m :: * -> *) a. Monad m => a -> m a
return MVector s Int
v'
                     Int
tag_parent <- URef s Int -> ST s (RefElement (URef s Int))
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> m (RefElement c)
readRef URef s Int
parentRef
                     do URef s Int -> RefElement (URef s Int) -> ST s ()
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> RefElement c -> m ()
writeRef URef s Int
parentRef Int
RefElement (URef s Int)
index
                        URef s Int -> RefElement (URef s Int) -> ST s ()
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> RefElement c -> m ()
writeRef URef s Int
sizeRef (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5)
                     do MVector (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
UMV.unsafeWrite MVector s Int
MVector (PrimState (ST s)) Int
v' Int
index Int
tag
                        MVector (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
UMV.unsafeWrite MVector s Int
MVector (PrimState (ST s)) Int
v' (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
tag_parent
                        MVector (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
UMV.unsafeWrite MVector s Int
MVector (PrimState (ST s)) Int
v' (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int
name_start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset0)
                        MVector (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
UMV.unsafeWrite MVector s Int
MVector (PrimState (ST s)) Int
v' (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Int
name_len
                        MVector (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
UMV.unsafeWrite MVector s Int
MVector (PrimState (ST s)) Int
v' (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Int
tag_end
              , attrF :: ByteString -> ByteString -> ST s ()
attrF = \(PS ForeignPtr Word8
_ Int
key_start Int
key_len) (PS ForeignPtr Word8
_ Int
value_start Int
value_len) -> do
                     Int
index <- URef s Int -> ST s (RefElement (URef s Int))
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> m (RefElement c)
readRef URef s Int
sizeRef
                     MVector s Int
v' <-
                       do MVector s Int
v <- STRef s (MVector s Int) -> ST s (MVector s Int)
forall s a. STRef s a -> ST s a
readSTRef STRef s (MVector s Int)
vecRef
                          if Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< MVector s Int -> Int
forall a s. Unbox a => MVector s a -> Int
UMV.length MVector s Int
v
                            then MVector s Int -> ST s (MVector s Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure MVector s Int
v
                            else do
                              MVector s Int
v' <- MVector (PrimState (ST s)) Int
-> Int -> ST s (MVector (PrimState (ST s)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
UMV.unsafeGrow MVector s Int
MVector (PrimState (ST s)) Int
v (Int -> Int -> Int -> Int -> Int
forall b a. (Integral b, Integral a) => Int -> Int -> a -> b -> b
predictGrowSize Int
value_start Int
value_len (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5) (MVector s Int -> Int
forall a s. Unbox a => MVector s a -> Int
UMV.length MVector s Int
v))
                              STRef s (MVector s Int) -> MVector s Int -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (MVector s Int)
vecRef MVector s Int
v'
                              MVector s Int -> ST s (MVector s Int)
forall (m :: * -> *) a. Monad m => a -> m a
return MVector s Int
v'
                     let tag :: Int
tag = Int
0x02
                     do URef s Int -> RefElement (URef s Int) -> ST s ()
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> RefElement c -> m ()
writeRef URef s Int
sizeRef (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5)
                     do MVector (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
UMV.unsafeWrite MVector s Int
MVector (PrimState (ST s)) Int
v' Int
index Int
tag
                        MVector (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
UMV.unsafeWrite MVector s Int
MVector (PrimState (ST s)) Int
v' (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
key_start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset0)
                        MVector (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
UMV.unsafeWrite MVector s Int
MVector (PrimState (ST s)) Int
v' (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Int
key_len
                        MVector (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
UMV.unsafeWrite MVector s Int
MVector (PrimState (ST s)) Int
v' (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) (Int
value_start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset0)
                        MVector (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
UMV.unsafeWrite MVector s Int
MVector (PrimState (ST s)) Int
v' (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Int
value_len
              , endOpenF :: ByteString -> ST s ()
endOpenF = \ByteString
_ -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
              , textF :: ByteString -> ST s ()
textF = \(PS ForeignPtr Word8
_ Int
text_start Int
text_len) -> do
                     let tag :: Int
tag = Int
0x01
                     Int
index <- URef s Int -> ST s (RefElement (URef s Int))
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> m (RefElement c)
readRef URef s Int
sizeRef
                     MVector s Int
v' <-
                       do MVector s Int
v <- STRef s (MVector s Int) -> ST s (MVector s Int)
forall s a. STRef s a -> ST s a
readSTRef STRef s (MVector s Int)
vecRef
                          if Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< MVector s Int -> Int
forall a s. Unbox a => MVector s a -> Int
UMV.length MVector s Int
v
                            then MVector s Int -> ST s (MVector s Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure MVector s Int
v
                            else do
                              MVector s Int
v' <- MVector (PrimState (ST s)) Int
-> Int -> ST s (MVector (PrimState (ST s)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
UMV.unsafeGrow MVector s Int
MVector (PrimState (ST s)) Int
v (Int -> Int -> Int -> Int -> Int
forall b a. (Integral b, Integral a) => Int -> Int -> a -> b -> b
predictGrowSize Int
text_start Int
text_len (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) (MVector s Int -> Int
forall a s. Unbox a => MVector s a -> Int
UMV.length MVector s Int
v))
                              STRef s (MVector s Int) -> MVector s Int -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (MVector s Int)
vecRef MVector s Int
v'
                              MVector s Int -> ST s (MVector s Int)
forall (m :: * -> *) a. Monad m => a -> m a
return MVector s Int
v'
                     do URef s Int -> RefElement (URef s Int) -> ST s ()
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> RefElement c -> m ()
writeRef URef s Int
sizeRef (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
                     do MVector (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
UMV.unsafeWrite MVector s Int
MVector (PrimState (ST s)) Int
v' Int
index Int
tag
                        MVector (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
UMV.unsafeWrite MVector s Int
MVector (PrimState (ST s)) Int
v' (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
text_start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset0)
                        MVector (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
UMV.unsafeWrite MVector s Int
MVector (PrimState (ST s)) Int
v' (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Int
text_len
              , closeF :: ByteString -> ST s ()
closeF = \ByteString
_ -> do
                     MVector s Int
v <- STRef s (MVector s Int) -> ST s (MVector s Int)
forall s a. STRef s a -> ST s a
readSTRef STRef s (MVector s Int)
vecRef
                     -- Set the tag_end slot of the parent.
                     Int
parent <- URef s Int -> ST s (RefElement (URef s Int))
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> m (RefElement c)
readRef URef s Int
parentRef
                     Int
index <- URef s Int -> ST s (RefElement (URef s Int))
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> m (RefElement c)
readRef URef s Int
sizeRef
                     MVector (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
UMV.unsafeWrite MVector s Int
MVector (PrimState (ST s)) Int
v (Int
parent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Int
index
                     -- Pop the stack and return to the parent element.
                     Int
previousParent <- MVector (PrimState (ST s)) Int -> Int -> ST s Int
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
UMV.unsafeRead MVector s Int
MVector (PrimState (ST s)) Int
v (Int
parent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                     URef s Int -> RefElement (URef s Int) -> ST s ()
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> RefElement c -> m ()
writeRef URef s Int
parentRef Int
RefElement (URef s Int)
previousParent
              , cdataF :: ByteString -> ST s ()
cdataF = \(PS ForeignPtr Word8
_ Int
cdata_start Int
cdata_len) -> do
                     let tag :: Int
tag = Int
0x03
                     Int
index <- URef s Int -> ST s (RefElement (URef s Int))
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> m (RefElement c)
readRef URef s Int
sizeRef
                     MVector s Int
v' <- do
                       MVector s Int
v <- STRef s (MVector s Int) -> ST s (MVector s Int)
forall s a. STRef s a -> ST s a
readSTRef STRef s (MVector s Int)
vecRef
                       if Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< MVector s Int -> Int
forall a s. Unbox a => MVector s a -> Int
UMV.length MVector s Int
v
                         then MVector s Int -> ST s (MVector s Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure MVector s Int
v
                         else do
                           MVector s Int
v' <- MVector (PrimState (ST s)) Int
-> Int -> ST s (MVector (PrimState (ST s)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
UMV.unsafeGrow MVector s Int
MVector (PrimState (ST s)) Int
v (Int -> Int -> Int -> Int -> Int
forall b a. (Integral b, Integral a) => Int -> Int -> a -> b -> b
predictGrowSize Int
cdata_start Int
cdata_len (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) (MVector s Int -> Int
forall a s. Unbox a => MVector s a -> Int
UMV.length MVector s Int
v))
                           STRef s (MVector s Int) -> MVector s Int -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (MVector s Int)
vecRef MVector s Int
v'
                           MVector s Int -> ST s (MVector s Int)
forall (m :: * -> *) a. Monad m => a -> m a
return MVector s Int
v'
                     URef s Int -> RefElement (URef s Int) -> ST s ()
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> RefElement c -> m ()
writeRef URef s Int
sizeRef (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
                     MVector (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
UMV.unsafeWrite MVector s Int
MVector (PrimState (ST s)) Int
v' Int
index Int
tag
                     MVector (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
UMV.unsafeWrite MVector s Int
MVector (PrimState (ST s)) Int
v' (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
cdata_start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset0)
                     MVector (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
UMV.unsafeWrite MVector s Int
MVector (PrimState (ST s)) Int
v' (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Int
cdata_len
              } ByteString
str
            MVector s Int
wet <- STRef s (MVector s Int) -> ST s (MVector s Int)
forall s a. STRef s a -> ST s a
readSTRef STRef s (MVector s Int)
vecRef
            Vector Int
arr <- MVector (PrimState (ST s)) Int -> ST s (Vector Int)
forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
UV.unsafeFreeze MVector s Int
MVector (PrimState (ST s)) Int
wet
            Int
size <- URef s Int -> ST s (RefElement (URef s Int))
forall c (m :: * -> *).
(MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
c -> m (RefElement c)
readRef URef s Int
sizeRef
            Vector Int -> ST s (Vector Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Vector Int -> Vector Int
forall a. Unbox a => Int -> Int -> Vector a -> Vector a
UV.unsafeSlice Int
0 Int
size Vector Int
arr))
            where
                -- Growing a large vector is slow, so we need to do it less times.
                -- We can predict final array size after processing some part (i.e. 1/4) of input XML.
                --
                -- predictGrowSize _bsStart _bsLen _index vecLen = round $ fromIntegral vecLen * (1.25 :: Double)
                predictGrowSize :: Int -> Int -> a -> b -> b
predictGrowSize Int
bsStart Int
bsLen a
index b
vecLen =
                    let -- at least 1 so we don't divide by zero below and end up with 
                        -- a negative grow size if (bsStart + bsLen - offset0) == 0
                        processedLen :: Int
processedLen = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
bsStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bsLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset0)
                        -- 1. Using integral operations, such as
                        --    "predictedTotalSize = (index * S.length str) `div` processedLen"
                        --    cause overflow, so we use float.
                        -- 2. Slightly enlarge predicted size to compensite copy on vector grow
                        --    if prediction is incorrect
                        k :: Double
k = (Double
1.25 :: Double) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
S.length ByteString
str) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
processedLen
                        predictedTotalSize :: b
predictedTotalSize = Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> b) -> Double -> b
forall a b. (a -> b) -> a -> b
$ a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
index Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
k
                        growSize :: b
growSize = b
predictedTotalSize b -> b -> b
forall a. Num a => a -> a -> a
- b
vecLen
                    in b
growSize