{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE CPP #-}
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 :: 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)
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 offset0 _ = str
#else
PS ForeignPtr Word8
_ Int
offset0 Int
_ = ByteString
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 (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 {
#if MIN_VERSION_bytestring(0,11,0)
openF = \(BS name_start name_len) -> do
#else
openF :: ByteString -> ST s ()
openF = \(PS ForeignPtr Word8
_ Int
name_start Int
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)
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 -> Int -> Int
distance Int
name_start 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
#if MIN_VERSION_bytestring(0,11,0)
, attrF = \(BS key_start key_len) (BS value_start value_len) -> do
#else
, 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
#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)
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 -> Int -> Int
distance Int
key_start 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 -> Int -> Int
distance Int
value_start 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 ()
#if MIN_VERSION_bytestring(0,11,0)
, textF = \(BS text_start text_len) -> do
#else
, textF :: ByteString -> ST s ()
textF = \(PS ForeignPtr Word8
_ Int
text_start Int
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)
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 -> Int -> Int
distance Int
text_start 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
#if MIN_VERSION_bytestring(0,11,0)
, closeF = \closeTag@(BS _ _) -> do
#else
, closeF :: ByteString -> ST s ()
closeF = \closeTag :: ByteString
closeTag@(PS ForeignPtr Word8
s Int
_ Int
_) -> 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
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
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 = BS (BS.plusForeignPtr offset0 parent_name) parent_len
#else
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
#endif
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
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
#if MIN_VERSION_bytestring(0,11,0)
, cdataF = \(BS cdata_start cdata_len) -> do
#else
, cdataF :: ByteString -> ST s ()
cdataF = \(PS ForeignPtr Word8
_ Int
cdata_start Int
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)
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 -> Int -> Int
distance Int
cdata_start 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
#if MIN_VERSION_bytestring(0,11,0)
minusForeignPtr :: ForeignPtr a -> ForeignPtr b -> Int
minusForeignPtr fpA fpB = unsafeDupablePerformIO $
withForeignPtr fpA $ \ptrA -> withForeignPtr fpB $ \ptrB ->
pure (minusPtr ptrA ptrB)
distance :: ForeignPtr a -> ForeignPtr b -> Int
distance = minusForeignPtr
#else
distance :: Int -> Int -> Int
distance :: Int -> Int -> Int
distance Int
a Int
b = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
b
#endif