{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- | 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
import           Data.ByteString.Internal(ByteString(..))
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)
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
    PS ForeignPtr Word8
_ Int
offset0 Int
_ = ByteString
str
    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 (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
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 (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
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.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 (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)
                    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) (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.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
              , 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.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 (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.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
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.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) (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.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 (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.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 (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.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
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.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
              , closeF :: ByteString -> ST s ()
closeF = \closeTag :: ByteString
closeTag@(PS ForeignPtr Word8
s Int
_ Int
_) -> 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
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
                 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)
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 (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)
                                      let openTag :: ByteString
openTag  = ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
s (Int
parent_nameInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset0) Int
parent_len
                                      Bool -> ST s Bool
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 ()
writeRef URef s Int
parentRef Int
RefElement (URef s Int)
previousParent
                   Bool -> ST s Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
correctTag -- continue closing tags, until matching one is found
              , 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.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 (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.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
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.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)
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))

untilM :: Monad m => m Bool -> m ()
untilM :: m Bool -> m ()
untilM m Bool
loop = do
  Bool
cond <- m Bool
loop
  case Bool
cond of
    Bool
True  -> () -> m ()
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