    {-# LANGUAGE BangPatterns               #-}
    {-# LANGUAGE DeriveAnyClass             #-}
    {-# LANGUAGE DeriveDataTypeable         #-}
    {-# LANGUAGE DeriveGeneric              #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE CPP                        #-}
    -- | DOM parser and API for XML.
    --   Slightly slower DOM parsing,
    --   but add missing close tags.
    module Xeno.DOM.Robust
      ( parse
      , Node
      , Content(..)
      , name
      , attributes
      , contents
      , children
      ) where

    import           Control.Monad.ST
    import           Control.Spork
    #if MIN_VERSION_bytestring(0,11,0)
    import           Data.ByteString.Internal as BS (ByteString(..), plusForeignPtr)
    #else
    import           Data.ByteString.Internal(ByteString(..))
    #endif
    import           Data.STRef
    import qualified Data.Vector.Unboxed         as UV
    import qualified Data.Vector.Unboxed.Mutable as UMV
    import           Data.Mutable(asURef, newRef, readRef, writeRef)
    #if MIN_VERSION_bytestring(0,11,0)
    import           Foreign.Ptr (minusPtr)
    import           Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
    import           System.IO.Unsafe (unsafeDupablePerformIO)
    #endif
    import           Xeno.SAX
    import           Xeno.Types
    import           Xeno.DOM.Internal(Node(..), Content(..), name, attributes, contents, children)

    -- | Parse a complete Nodes document.
    parse :: ByteString -> Either XenoException Node
    parse :: ByteString -> Either XenoException Node
    parse ByteString
    inp =
      case Vector Int -> Either XenoException (Vector Int)
    forall e a. Exception e => a -> Either e a
    spork Vector Int
    node of
        Left XenoException
    e -> XenoException -> Either XenoException Node
    forall a b. a -> Either a b
    Left XenoException
    e
        Right Vector Int
    r ->
          case Vector Int -> Maybe Node
    findRootNode Vector Int
    r of
            Just Node
    n -> Node -> Either XenoException Node
    forall a b. b -> Either a b
    Right Node
    n
            Maybe Node
    Nothing -> XenoException -> Either XenoException Node
    forall a b. a -> Either a b
    Left XenoException
    XenoExpectRootNode
      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
    #if MIN_VERSION_bytestring(0,11,0)
        BS ForeignPtr Word8
    offset0 Int
    _ = ByteString
    str
    #else
        PS _ offset0 _ = str
    #endif
        str :: ByteString
    str = ByteString -> ByteString
    skipDoctype ByteString
    inp
        node :: Vector Int
    node =
          (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.new Int
    1000
                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 a b. (a -> b) -> ST s a -> ST s b
    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 (ST s (URef s Int) -> ST s (URef s Int))
    -> ST s (URef s Int) -> ST s (URef s Int)
    forall a b. (a -> b) -> a -> b
    $ RefElement (URef s Int) -> ST s (URef s Int)
    forall c (m :: * -> *).
    (MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
    RefElement c -> m c
    forall (m :: * -> *).
    (PrimMonad m, PrimState m ~ MCState (URef s Int)) =>
    RefElement (URef s Int) -> m (URef s Int)
    newRef Int
    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 a b. (a -> b) -> ST s a -> ST s b
    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 (ST s (URef s Int) -> ST s (URef s Int))
    -> ST s (URef s Int) -> ST s (URef s Int)
    forall a b. (a -> b) -> a -> b
    $ RefElement (URef s Int) -> ST s (URef s Int)
    forall c (m :: * -> *).
    (MutableRef c, PrimMonad m, PrimState m ~ MCState c) =>
    RefElement c -> m c
    forall (m :: * -> *).
    (PrimMonad m, PrimState m ~ MCState (URef s Int)) =>
    RefElement (URef s Int) -> m (URef s Int)
    newRef Int
    RefElement (URef s Int)
    0
                Process (ST s ()) -> ByteString -> ST s ()
    forall (m :: * -> *) str.
    (Monad m, StringLike str) =>
    Process (m ()) -> str -> m ()
    process Process {
    #if MIN_VERSION_bytestring(0,11,0)
                    openF :: ByteString -> ST s ()
    openF = \(BS ForeignPtr Word8
    name_start Int
    name_len) -> do
    #else
                    openF = \(PS _ name_start name_len) -> do
    #endif
                     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)
    forall (m :: * -> *).
    (PrimMonad m, PrimState m ~ MCState (URef s Int)) =>
    URef s Int -> m (RefElement (URef s Int))
    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 a. a -> ST s a
    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.grow MVector s Int
    MVector (PrimState (ST s)) Int
    v (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 a. a -> ST s a
    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)
    forall (m :: * -> *).
    (PrimMonad m, PrimState m ~ MCState (URef s Int)) =>
    URef s Int -> m (RefElement (URef s Int))
    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 ()
    forall (m :: * -> *).
    (PrimMonad m, PrimState m ~ MCState (URef s Int)) =>
    URef s Int -> RefElement (URef s Int) -> 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 ()
    forall (m :: * -> *).
    (PrimMonad m, PrimState m ~ MCState (URef s Int)) =>
    URef s Int -> RefElement (URef s Int) -> m ()
    writeRef URef s Int
    sizeRef (Int
    index Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    5)
                        MVector (PrimState (ST s)) Int -> Int -> Int -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Unbox a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    UMV.write 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.write 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.write MVector s Int
    MVector (PrimState (ST s)) Int
    v' (Int
    index Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2) (ForeignPtr Word8 -> ForeignPtr Word8 -> Int
    forall a b. ForeignPtr a -> ForeignPtr b -> Int
    distance ForeignPtr Word8
    name_start ForeignPtr Word8
    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.write 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.write 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
    #if MIN_VERSION_bytestring(0,11,0)
                  , attrF :: ByteString -> ByteString -> ST s ()
    attrF = \(BS ForeignPtr Word8
    key_start Int
    key_len) (BS ForeignPtr Word8
    value_start Int
    value_len) -> do
    #else
                  , attrF = \(PS _ key_start key_len) (PS _ value_start value_len) -> do
    #endif
                     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)
    forall (m :: * -> *).
    (PrimMonad m, PrimState m ~ MCState (URef s Int)) =>
    URef s Int -> m (RefElement (URef s Int))
    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 a. a -> ST s a
    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.grow MVector s Int
    MVector (PrimState (ST s)) Int
    v (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 a. a -> ST s a
    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 ()
    forall (m :: * -> *).
    (PrimMonad m, PrimState m ~ MCState (URef s Int)) =>
    URef s Int -> RefElement (URef s Int) -> 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.write 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.write MVector s Int
    MVector (PrimState (ST s)) Int
    v' (Int
    index Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (ForeignPtr Word8 -> ForeignPtr Word8 -> Int
    forall a b. ForeignPtr a -> ForeignPtr b -> Int
    distance ForeignPtr Word8
    key_start ForeignPtr Word8
    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.write 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.write MVector s Int
    MVector (PrimState (ST s)) Int
    v' (Int
    index Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3) (ForeignPtr Word8 -> ForeignPtr Word8 -> Int
    forall a b. ForeignPtr a -> ForeignPtr b -> Int
    distance ForeignPtr Word8
    value_start ForeignPtr Word8
    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.write 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 a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    #if MIN_VERSION_bytestring(0,11,0)
                  , textF :: ByteString -> ST s ()
    textF = \(BS ForeignPtr Word8
    text_start Int
    text_len) -> do
    #else
                  , textF = \(PS _ text_start text_len) -> do
    #endif
                     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)
    forall (m :: * -> *).
    (PrimMonad m, PrimState m ~ MCState (URef s Int)) =>
    URef s Int -> m (RefElement (URef s Int))
    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 a. a -> ST s a
    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.grow MVector s Int
    MVector (PrimState (ST s)) Int
    v (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 a. a -> ST s a
    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 ()
    forall (m :: * -> *).
    (PrimMonad m, PrimState m ~ MCState (URef s Int)) =>
    URef s Int -> RefElement (URef s Int) -> 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.write 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.write MVector s Int
    MVector (PrimState (ST s)) Int
    v' (Int
    index Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (ForeignPtr Word8 -> ForeignPtr Word8 -> Int
    forall a b. ForeignPtr a -> ForeignPtr b -> Int
    distance ForeignPtr Word8
    text_start ForeignPtr Word8
    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.write 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
    #if MIN_VERSION_bytestring(0,11,0)
                  , closeF :: ByteString -> ST s ()
    closeF = \closeTag :: ByteString
    closeTag@(BS ForeignPtr Word8
    _ Int
    _) -> do
    #else
                  , closeF = \closeTag@(PS s _ _) -> do
    #endif
                     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
    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)
    forall (m :: * -> *).
    (PrimMonad m, PrimState m ~ MCState (URef s Int)) =>
    URef s Int -> m (RefElement (URef s Int))
    readRef URef s Int
    sizeRef
                     ST s Bool -> ST s ()
    forall (m :: * -> *). Monad m => m Bool -> m ()
    untilM (ST s Bool -> ST s ()) -> ST s Bool -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ do
                       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)
    forall (m :: * -> *).
    (PrimMonad m, PrimState m ~ MCState (URef s Int)) =>
    URef s Int -> m (RefElement (URef s Int))
    readRef URef s Int
    parentRef
                       Bool
    correctTag <- if Int
    parent Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0
                                        then Bool -> ST s Bool
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True -- no more tags to close!!!
                                        else do
                                          Int
    parent_name <- MVector (PrimState (ST s)) Int -> Int -> ST s Int
    forall (m :: * -> *) a.
    (PrimMonad m, Unbox a) =>
    MVector (PrimState m) a -> Int -> m a
    UMV.read MVector s Int
    MVector (PrimState (ST s)) Int
    v (Int
    parent Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2)
                                          Int
    parent_len  <- MVector (PrimState (ST s)) Int -> Int -> ST s Int
    forall (m :: * -> *) a.
    (PrimMonad m, Unbox a) =>
    MVector (PrimState m) a -> Int -> m a
    UMV.read MVector s Int
    MVector (PrimState (ST s)) Int
    v (Int
    parent Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3)
    #if MIN_VERSION_bytestring(0,11,0)
                                          let openTag :: ByteString
    openTag  = ForeignPtr Word8 -> Int -> ByteString
    BS (ForeignPtr Word8 -> Int -> ForeignPtr Word8
    forall a b. ForeignPtr a -> Int -> ForeignPtr b
    BS.plusForeignPtr ForeignPtr Word8
    offset0 Int
    parent_name) Int
    parent_len
    #else
                                          let openTag  = PS s (parent_name+offset0) parent_len
    #endif
                                          Bool -> ST s Bool
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return       (Bool -> ST s Bool) -> Bool -> ST s Bool
    forall a b. (a -> b) -> a -> b
    $ ByteString
    openTag ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    closeTag
                       MVector (PrimState (ST s)) Int -> Int -> Int -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Unbox a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    UMV.write                  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.read 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 ()
    forall (m :: * -> *).
    (PrimMonad m, PrimState m ~ MCState (URef s Int)) =>
    URef s Int -> RefElement (URef s Int) -> m ()
    writeRef URef s Int
    parentRef Int
    RefElement (URef s Int)
    previousParent
                       Bool -> ST s Bool
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    correctTag -- continue closing tags, until matching one is found
    #if MIN_VERSION_bytestring(0,11,0)
                  , cdataF :: ByteString -> ST s ()
    cdataF = \(BS ForeignPtr Word8
    cdata_start Int
    cdata_len) -> do
    #else
                  , cdataF = \(PS _ cdata_start cdata_len) -> do
    #endif
                     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)
    forall (m :: * -> *).
    (PrimMonad m, PrimState m ~ MCState (URef s Int)) =>
    URef s Int -> m (RefElement (URef s Int))
    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 a. a -> ST s a
    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.grow MVector s Int
    MVector (PrimState (ST s)) Int
    v (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 a. a -> ST s a
    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 ()
    forall (m :: * -> *).
    (PrimMonad m, PrimState m ~ MCState (URef s Int)) =>
    URef s Int -> RefElement (URef s Int) -> 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.write 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.write MVector s Int
    MVector (PrimState (ST s)) Int
    v' (Int
    index Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (ForeignPtr Word8 -> ForeignPtr Word8 -> Int
    forall a b. ForeignPtr a -> ForeignPtr b -> Int
    distance ForeignPtr Word8
    cdata_start ForeignPtr Word8
    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.write 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)
    forall (m :: * -> *).
    (PrimMonad m, PrimState m ~ MCState (URef s Int)) =>
    URef s Int -> m (RefElement (URef s Int))
    readRef URef s Int
    sizeRef
                Vector Int -> ST s (Vector Int)
    forall a. a -> ST s a
    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))

    untilM :: Monad m => m Bool -> m ()
    untilM :: forall (m :: * -> *). Monad m => m Bool -> m ()
    untilM m Bool
    loop = do
      Bool
    cond <- m Bool
    loop
      case Bool
    cond of
        Bool
    True  -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        Bool
    False -> m Bool -> m ()
    forall (m :: * -> *). Monad m => m Bool -> m ()
    untilM m Bool
    loop

    #if MIN_VERSION_bytestring(0,11,0)
    minusForeignPtr :: ForeignPtr a -> ForeignPtr b -> Int
    minusForeignPtr :: forall a b. ForeignPtr a -> ForeignPtr b -> Int
    minusForeignPtr ForeignPtr a
    fpA ForeignPtr b
    fpB = IO Int -> Int
    forall a. IO a -> a
    unsafeDupablePerformIO (IO Int -> Int) -> IO Int -> Int
    forall a b. (a -> b) -> a -> b
    $
      ForeignPtr a -> (Ptr a -> IO Int) -> IO Int
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr ForeignPtr a
    fpA ((Ptr a -> IO Int) -> IO Int) -> (Ptr a -> IO Int) -> IO Int
    forall a b. (a -> b) -> a -> b
    $ \Ptr a
    ptrA -> ForeignPtr b -> (Ptr b -> IO Int) -> IO Int
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr ForeignPtr b
    fpB ((Ptr b -> IO Int) -> IO Int) -> (Ptr b -> IO Int) -> IO Int
    forall a b. (a -> b) -> a -> b
    $ \Ptr b
    ptrB ->
        Int -> IO Int
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Ptr a -> Ptr b -> Int
    forall a b. Ptr a -> Ptr b -> Int
    minusPtr Ptr a
    ptrA Ptr b
    ptrB)

    distance :: ForeignPtr a -> ForeignPtr b -> Int
    distance :: forall a b. ForeignPtr a -> ForeignPtr b -> Int
    distance = ForeignPtr a -> ForeignPtr b -> Int
    forall a b. ForeignPtr a -> ForeignPtr b -> Int
    minusForeignPtr
    #else
    distance :: Int -> Int -> Int
    distance a b = a - b
    #endif