{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash, UnboxedTuples,
NamedFieldPuns, BangPatterns #-}
{-# OPTIONS_HADDOCK prune #-}
#if __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Trustworthy #-}
#endif
module Data.ByteString (
ByteString,
empty,
singleton,
pack,
unpack,
cons,
snoc,
append,
head,
uncons,
unsnoc,
last,
tail,
init,
null,
length,
map,
reverse,
intersperse,
intercalate,
transpose,
foldl,
foldl',
foldl1,
foldl1',
foldr,
foldr',
foldr1,
foldr1',
concat,
concatMap,
any,
all,
maximum,
minimum,
scanl,
scanl1,
scanr,
scanr1,
mapAccumL,
mapAccumR,
replicate,
unfoldr,
unfoldrN,
take,
drop,
splitAt,
takeWhile,
takeWhileEnd,
dropWhile,
dropWhileEnd,
span,
spanEnd,
break,
breakEnd,
group,
groupBy,
inits,
tails,
stripPrefix,
stripSuffix,
split,
splitWith,
isPrefixOf,
isSuffixOf,
isInfixOf,
breakSubstring,
findSubstring,
findSubstrings,
elem,
notElem,
find,
filter,
partition,
index,
elemIndex,
elemIndices,
elemIndexEnd,
findIndex,
findIndices,
findIndexEnd,
count,
zip,
zipWith,
unzip,
sort,
copy,
packCString,
packCStringLen,
useAsCString,
useAsCStringLen,
getLine,
getContents,
putStr,
putStrLn,
interact,
readFile,
writeFile,
appendFile,
hGetLine,
hGetContents,
hGet,
hGetSome,
hGetNonBlocking,
hPut,
hPutNonBlocking,
hPutStr,
hPutStrLn,
breakByte
) where
import qualified Prelude as P
import Prelude hiding (reverse,head,tail,last,init,null
,length,map,lines,foldl,foldr,unlines
,concat,any,take,drop,splitAt,takeWhile
,dropWhile,span,break,elem,filter,maximum
,minimum,all,concatMap,foldl1,foldr1
,scanl,scanl1,scanr,scanr1
,readFile,writeFile,appendFile,replicate
,getContents,getLine,putStr,putStrLn,interact
,zip,zipWith,unzip,notElem
#if !MIN_VERSION_base(4,6,0)
,catch
#endif
)
#if MIN_VERSION_base(4,7,0)
import Data.Bits (finiteBitSize, shiftL, (.|.), (.&.))
#else
import Data.Bits (bitSize, shiftL, (.|.), (.&.))
#endif
import Data.ByteString.Internal
import Data.ByteString.Unsafe
import qualified Data.List as List
import Data.Word (Word8)
import Data.Maybe (isJust)
import Control.Exception (IOException, catch, finally, assert, throwIO)
import Control.Monad (when)
import Foreign.C.String (CString, CStringLen)
import Foreign.C.Types (CSize)
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, touchForeignPtr)
#if MIN_VERSION_base(4,5,0)
import Foreign.ForeignPtr.Unsafe(unsafeForeignPtrToPtr)
#else
import Foreign.ForeignPtr (unsafeForeignPtrToPtr)
#endif
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Array (allocaArray)
import Foreign.Ptr
import Foreign.Storable (Storable(..))
import System.IO (stdin,stdout,hClose,hFileSize
,hGetBuf,hPutBuf,hGetBufNonBlocking
,hPutBufNonBlocking,withBinaryFile
,IOMode(..))
import System.IO.Error (mkIOError, illegalOperationErrorType)
#if !(MIN_VERSION_base(4,8,0))
import Data.Monoid (Monoid(..))
#endif
#if MIN_VERSION_base(4,3,0)
import System.IO (hGetBufSome)
#else
import System.IO (hWaitForInput, hIsEOF)
#endif
import Data.IORef
import GHC.IO.Handle.Internals
import GHC.IO.Handle.Types
import GHC.IO.Buffer
import GHC.IO.BufferedIO as Buffered
import GHC.IO (unsafePerformIO, unsafeDupablePerformIO)
import Data.Char (ord)
import Foreign.Marshal.Utils (copyBytes)
import GHC.Prim (Word#)
import GHC.Base (build)
import GHC.Word hiding (Word8)
#if !(MIN_VERSION_base(4,7,0))
finiteBitSize = bitSize
#endif
empty :: ByteString
empty :: ByteString
empty = ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
nullForeignPtr Int
0 Int
0
singleton :: Word8 -> ByteString
singleton :: Word8 -> ByteString
singleton Word8
c = Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
1 ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p Word8
c
{-# INLINE [1] singleton #-}
pack :: [Word8] -> ByteString
pack :: [Word8] -> ByteString
pack = [Word8] -> ByteString
packBytes
unpack :: ByteString -> [Word8]
unpack :: ByteString -> [Word8]
unpack ByteString
bs = (forall b. (Word8 -> b -> b) -> b -> b) -> [Word8]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (ByteString -> (Word8 -> b -> b) -> b -> b
forall a. ByteString -> (Word8 -> a -> a) -> a -> a
unpackFoldr ByteString
bs)
{-# INLINE unpack #-}
unpackFoldr :: ByteString -> (Word8 -> a -> a) -> a -> a
unpackFoldr :: ByteString -> (Word8 -> a -> a) -> a -> a
unpackFoldr ByteString
bs Word8 -> a -> a
k a
z = (Word8 -> a -> a) -> a -> ByteString -> a
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
foldr Word8 -> a -> a
k a
z ByteString
bs
{-# INLINE [0] unpackFoldr #-}
{-# RULES
"ByteString unpack-list" [1] forall bs .
unpackFoldr bs (:) [] = unpackBytes bs
#-}
null :: ByteString -> Bool
null :: ByteString -> Bool
null (PS ForeignPtr Word8
_ Int
_ Int
l) = Bool -> Bool -> Bool
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
{-# INLINE null #-}
length :: ByteString -> Int
length :: ByteString -> Int
length (PS ForeignPtr Word8
_ Int
_ Int
l) = Bool -> Int -> Int
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) Int
l
{-# INLINE length #-}
infixr 5 `cons`
infixl 5 `snoc`
cons :: Word8 -> ByteString -> ByteString
cons :: Word8 -> ByteString -> ByteString
cons Word8
c (PS ForeignPtr Word8
x Int
s Int
l) = Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
f -> do
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p Word8
c
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Ptr Word8
f Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s) (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
{-# INLINE cons #-}
snoc :: ByteString -> Word8 -> ByteString
snoc :: ByteString -> Word8 -> ByteString
snoc (PS ForeignPtr Word8
x Int
s Int
l) Word8
c = Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
f -> do
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
p (Ptr Word8
f Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s) (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
l) Word8
c
{-# INLINE snoc #-}
head :: ByteString -> Word8
head :: ByteString -> Word8
head (PS ForeignPtr Word8
x Int
s Int
l)
| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = String -> Word8
forall a. String -> a
errorEmptyList String
"head"
| Bool
otherwise = IO Word8 -> Word8
forall a. IO a -> a
accursedUnutterablePerformIO (IO Word8 -> Word8) -> IO Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO Word8) -> IO Word8)
-> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
p Int
s
{-# INLINE head #-}
tail :: ByteString -> ByteString
tail :: ByteString -> ByteString
tail (PS ForeignPtr Word8
p Int
s Int
l)
| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = String -> ByteString
forall a. String -> a
errorEmptyList String
"tail"
| Bool
otherwise = ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
p (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
{-# INLINE tail #-}
uncons :: ByteString -> Maybe (Word8, ByteString)
uncons :: ByteString -> Maybe (Word8, ByteString)
uncons (PS ForeignPtr Word8
x Int
s Int
l)
| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Maybe (Word8, ByteString)
forall a. Maybe a
Nothing
| Bool
otherwise = (Word8, ByteString) -> Maybe (Word8, ByteString)
forall a. a -> Maybe a
Just (IO Word8 -> Word8
forall a. IO a -> a
accursedUnutterablePerformIO (IO Word8 -> Word8) -> IO Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x
((Ptr Word8 -> IO Word8) -> IO Word8)
-> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
p Int
s,
ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
x (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
{-# INLINE uncons #-}
last :: ByteString -> Word8
last :: ByteString -> Word8
last ps :: ByteString
ps@(PS ForeignPtr Word8
x Int
s Int
l)
| ByteString -> Bool
null ByteString
ps = String -> Word8
forall a. String -> a
errorEmptyList String
"last"
| Bool
otherwise = IO Word8 -> Word8
forall a. IO a -> a
accursedUnutterablePerformIO (IO Word8 -> Word8) -> IO Word8 -> Word8
forall a b. (a -> b) -> a -> b
$
ForeignPtr Word8 -> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO Word8) -> IO Word8)
-> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
p (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
{-# INLINE last #-}
init :: ByteString -> ByteString
init :: ByteString -> ByteString
init ps :: ByteString
ps@(PS ForeignPtr Word8
p Int
s Int
l)
| ByteString -> Bool
null ByteString
ps = String -> ByteString
forall a. String -> a
errorEmptyList String
"init"
| Bool
otherwise = ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
p Int
s (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
{-# INLINE init #-}
unsnoc :: ByteString -> Maybe (ByteString, Word8)
unsnoc :: ByteString -> Maybe (ByteString, Word8)
unsnoc (PS ForeignPtr Word8
x Int
s Int
l)
| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Maybe (ByteString, Word8)
forall a. Maybe a
Nothing
| Bool
otherwise = (ByteString, Word8) -> Maybe (ByteString, Word8)
forall a. a -> Maybe a
Just (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
x Int
s (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1),
IO Word8 -> Word8
forall a. IO a -> a
accursedUnutterablePerformIO (IO Word8 -> Word8) -> IO Word8 -> Word8
forall a b. (a -> b) -> a -> b
$
ForeignPtr Word8 -> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO Word8) -> IO Word8)
-> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
p (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
{-# INLINE unsnoc #-}
append :: ByteString -> ByteString -> ByteString
append :: ByteString -> ByteString -> ByteString
append = ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
mappend
{-# INLINE append #-}
map :: (Word8 -> Word8) -> ByteString -> ByteString
map :: (Word8 -> Word8) -> ByteString -> ByteString
map Word8 -> Word8
f (PS ForeignPtr Word8
fp Int
s Int
len) = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
a ->
Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
len ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Ptr Word8 -> Ptr Word8 -> IO ()
map_ Int
0 (Ptr Word8
a Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s)
where
map_ :: Int -> Ptr Word8 -> Ptr Word8 -> IO ()
map_ :: Int -> Ptr Word8 -> Ptr Word8 -> IO ()
map_ !Int
n !Ptr Word8
p1 !Ptr Word8
p2
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
Word8
x <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
p1 Int
n
Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
p2 Int
n (Word8 -> Word8
f Word8
x)
Int -> Ptr Word8 -> Ptr Word8 -> IO ()
map_ (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Ptr Word8
p1 Ptr Word8
p2
{-# INLINE map #-}
reverse :: ByteString -> ByteString
reverse :: ByteString -> ByteString
reverse (PS ForeignPtr Word8
x Int
s Int
l) = Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
l ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
f ->
Ptr Word8 -> Ptr Word8 -> CULong -> IO ()
c_reverse Ptr Word8
p (Ptr Word8
f Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s) (Int -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
intersperse :: Word8 -> ByteString -> ByteString
intersperse :: Word8 -> ByteString -> ByteString
intersperse Word8
c ps :: ByteString
ps@(PS ForeignPtr Word8
x Int
s Int
l)
| ByteString -> Int
length ByteString
ps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = ByteString
ps
| Bool
otherwise = Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
f ->
Ptr Word8 -> Ptr Word8 -> CULong -> Word8 -> IO ()
c_intersperse Ptr Word8
p (Ptr Word8
f Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s) (Int -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) Word8
c
transpose :: [ByteString] -> [ByteString]
transpose :: [ByteString] -> [ByteString]
transpose [ByteString]
ps = ([Word8] -> ByteString) -> [[Word8]] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
P.map [Word8] -> ByteString
pack ([[Word8]] -> [ByteString])
-> ([ByteString] -> [[Word8]]) -> [ByteString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Word8]] -> [[Word8]]
forall a. [[a]] -> [[a]]
List.transpose ([[Word8]] -> [[Word8]])
-> ([ByteString] -> [[Word8]]) -> [ByteString] -> [[Word8]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [Word8]) -> [ByteString] -> [[Word8]]
forall a b. (a -> b) -> [a] -> [b]
P.map ByteString -> [Word8]
unpack ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ [ByteString]
ps
foldl :: (a -> Word8 -> a) -> a -> ByteString -> a
foldl :: (a -> Word8 -> a) -> a -> ByteString -> a
foldl a -> Word8 -> a
f a
z (PS ForeignPtr Word8
fp Int
off Int
len) =
let p :: Ptr Word8
p = ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fp
in Ptr Word8 -> Ptr Word8 -> a
go (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
where
go :: Ptr Word8 -> Ptr Word8 -> a
go !Ptr Word8
p !Ptr Word8
q | Ptr Word8
p Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
q = a
z
| Bool
otherwise = let !x :: Word8
x = IO Word8 -> Word8
forall a. IO a -> a
accursedUnutterablePerformIO (IO Word8 -> Word8) -> IO Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ do
Word8
x' <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p
ForeignPtr Word8 -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Word8
fp
Word8 -> IO Word8
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
x'
in a -> Word8 -> a
f (Ptr Word8 -> Ptr Word8 -> a
go (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)) Ptr Word8
q) Word8
x
{-# INLINE foldl #-}
foldl' :: (a -> Word8 -> a) -> a -> ByteString -> a
foldl' :: (a -> Word8 -> a) -> a -> ByteString -> a
foldl' a -> Word8 -> a
f a
v (PS ForeignPtr Word8
fp Int
off Int
len) =
IO a -> a
forall a. IO a -> a
accursedUnutterablePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO a) -> IO a) -> (Ptr Word8 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
a -> Ptr Word8 -> Ptr Word8 -> IO a
go a
v (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off) (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
len))
where
go :: a -> Ptr Word8 -> Ptr Word8 -> IO a
go !a
z !Ptr Word8
p !Ptr Word8
q | Ptr Word8
p Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
q = a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
z
| Bool
otherwise = do Word8
x <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p
a -> Ptr Word8 -> Ptr Word8 -> IO a
go (a -> Word8 -> a
f a
z Word8
x) (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Ptr Word8
q
{-# INLINE foldl' #-}
foldr :: (Word8 -> a -> a) -> a -> ByteString -> a
foldr :: (Word8 -> a -> a) -> a -> ByteString -> a
foldr Word8 -> a -> a
k a
z (PS ForeignPtr Word8
fp Int
off Int
len) =
let p :: Ptr Word8
p = ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fp
in Ptr Word8 -> Ptr Word8 -> a
go (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off) (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
len))
where
go :: Ptr Word8 -> Ptr Word8 -> a
go !Ptr Word8
p !Ptr Word8
q | Ptr Word8
p Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
q = a
z
| Bool
otherwise = let !x :: Word8
x = IO Word8 -> Word8
forall a. IO a -> a
accursedUnutterablePerformIO (IO Word8 -> Word8) -> IO Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ do
Word8
x' <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p
ForeignPtr Word8 -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Word8
fp
Word8 -> IO Word8
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
x'
in Word8 -> a -> a
k Word8
x (Ptr Word8 -> Ptr Word8 -> a
go (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Ptr Word8
q)
{-# INLINE foldr #-}
foldr' :: (Word8 -> a -> a) -> a -> ByteString -> a
foldr' :: (Word8 -> a -> a) -> a -> ByteString -> a
foldr' Word8 -> a -> a
k a
v (PS ForeignPtr Word8
fp Int
off Int
len) =
IO a -> a
forall a. IO a -> a
accursedUnutterablePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO a) -> IO a) -> (Ptr Word8 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
a -> Ptr Word8 -> Ptr Word8 -> IO a
go a
v (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
where
go :: a -> Ptr Word8 -> Ptr Word8 -> IO a
go !a
z !Ptr Word8
p !Ptr Word8
q | Ptr Word8
p Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
q = a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
z
| Bool
otherwise = do Word8
x <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p
a -> Ptr Word8 -> Ptr Word8 -> IO a
go (Word8 -> a -> a
k Word8
x a
z) (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)) Ptr Word8
q
{-# INLINE foldr' #-}
foldl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldl1 Word8 -> Word8 -> Word8
f ByteString
ps
| ByteString -> Bool
null ByteString
ps = String -> Word8
forall a. String -> a
errorEmptyList String
"foldl1"
| Bool
otherwise = (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> Word8
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
foldl Word8 -> Word8 -> Word8
f (ByteString -> Word8
unsafeHead ByteString
ps) (ByteString -> ByteString
unsafeTail ByteString
ps)
{-# INLINE foldl1 #-}
foldl1' :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldl1' :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldl1' Word8 -> Word8 -> Word8
f ByteString
ps
| ByteString -> Bool
null ByteString
ps = String -> Word8
forall a. String -> a
errorEmptyList String
"foldl1'"
| Bool
otherwise = (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> Word8
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
foldl' Word8 -> Word8 -> Word8
f (ByteString -> Word8
unsafeHead ByteString
ps) (ByteString -> ByteString
unsafeTail ByteString
ps)
{-# INLINE foldl1' #-}
foldr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldr1 Word8 -> Word8 -> Word8
f ByteString
ps
| ByteString -> Bool
null ByteString
ps = String -> Word8
forall a. String -> a
errorEmptyList String
"foldr1"
| Bool
otherwise = (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> Word8
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
foldr Word8 -> Word8 -> Word8
f (ByteString -> Word8
unsafeLast ByteString
ps) (ByteString -> ByteString
unsafeInit ByteString
ps)
{-# INLINE foldr1 #-}
foldr1' :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldr1' :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldr1' Word8 -> Word8 -> Word8
f ByteString
ps
| ByteString -> Bool
null ByteString
ps = String -> Word8
forall a. String -> a
errorEmptyList String
"foldr1"
| Bool
otherwise = (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> Word8
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
foldr' Word8 -> Word8 -> Word8
f (ByteString -> Word8
unsafeLast ByteString
ps) (ByteString -> ByteString
unsafeInit ByteString
ps)
{-# INLINE foldr1' #-}
concat :: [ByteString] -> ByteString
concat :: [ByteString] -> ByteString
concat = [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
concatMap :: (Word8 -> ByteString) -> ByteString -> ByteString
concatMap :: (Word8 -> ByteString) -> ByteString -> ByteString
concatMap Word8 -> ByteString
f = [ByteString] -> ByteString
concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> [ByteString] -> [ByteString])
-> [ByteString] -> ByteString -> [ByteString]
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
foldr ((:) (ByteString -> [ByteString] -> [ByteString])
-> (Word8 -> ByteString) -> Word8 -> [ByteString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString
f) []
any :: (Word8 -> Bool) -> ByteString -> Bool
any :: (Word8 -> Bool) -> ByteString -> Bool
any Word8 -> Bool
_ (PS ForeignPtr Word8
_ Int
_ Int
0) = Bool
False
any Word8 -> Bool
f (PS ForeignPtr Word8
x Int
s Int
l) = IO Bool -> Bool
forall a. IO a -> a
accursedUnutterablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
Ptr Word8 -> Ptr Word8 -> IO Bool
go (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s) (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l))
where
go :: Ptr Word8 -> Ptr Word8 -> IO Bool
go !Ptr Word8
p !Ptr Word8
q | Ptr Word8
p Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
q = Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
| Bool
otherwise = do Word8
c <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p
if Word8 -> Bool
f Word8
c then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else Ptr Word8 -> Ptr Word8 -> IO Bool
go (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Ptr Word8
q
{-# INLINE any #-}
all :: (Word8 -> Bool) -> ByteString -> Bool
all :: (Word8 -> Bool) -> ByteString -> Bool
all Word8 -> Bool
_ (PS ForeignPtr Word8
_ Int
_ Int
0) = Bool
True
all Word8 -> Bool
f (PS ForeignPtr Word8
x Int
s Int
l) = IO Bool -> Bool
forall a. IO a -> a
accursedUnutterablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
Ptr Word8 -> Ptr Word8 -> IO Bool
go (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s) (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l))
where
go :: Ptr Word8 -> Ptr Word8 -> IO Bool
go !Ptr Word8
p !Ptr Word8
q | Ptr Word8
p Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
q = Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
| Bool
otherwise = do Word8
c <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p
if Word8 -> Bool
f Word8
c
then Ptr Word8 -> Ptr Word8 -> IO Bool
go (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Ptr Word8
q
else Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
{-# INLINE all #-}
maximum :: ByteString -> Word8
maximum :: ByteString -> Word8
maximum xs :: ByteString
xs@(PS ForeignPtr Word8
x Int
s Int
l)
| ByteString -> Bool
null ByteString
xs = String -> Word8
forall a. String -> a
errorEmptyList String
"maximum"
| Bool
otherwise = IO Word8 -> Word8
forall a. IO a -> a
accursedUnutterablePerformIO (IO Word8 -> Word8) -> IO Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO Word8) -> IO Word8)
-> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
Ptr Word8 -> CULong -> IO Word8
c_maximum (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s) (Int -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
{-# INLINE maximum #-}
minimum :: ByteString -> Word8
minimum :: ByteString -> Word8
minimum xs :: ByteString
xs@(PS ForeignPtr Word8
x Int
s Int
l)
| ByteString -> Bool
null ByteString
xs = String -> Word8
forall a. String -> a
errorEmptyList String
"minimum"
| Bool
otherwise = IO Word8 -> Word8
forall a. IO a -> a
accursedUnutterablePerformIO (IO Word8 -> Word8) -> IO Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO Word8) -> IO Word8)
-> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
Ptr Word8 -> CULong -> IO Word8
c_minimum (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s) (Int -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
{-# INLINE minimum #-}
mapAccumL :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)
mapAccumL :: (acc -> Word8 -> (acc, Word8))
-> acc -> ByteString -> (acc, ByteString)
mapAccumL acc -> Word8 -> (acc, Word8)
f acc
acc (PS ForeignPtr Word8
fp Int
o Int
len) = IO (acc, ByteString) -> (acc, ByteString)
forall a. IO a -> a
unsafeDupablePerformIO (IO (acc, ByteString) -> (acc, ByteString))
-> IO (acc, ByteString) -> (acc, ByteString)
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8
-> (Ptr Word8 -> IO (acc, ByteString)) -> IO (acc, ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO (acc, ByteString)) -> IO (acc, ByteString))
-> (Ptr Word8 -> IO (acc, ByteString)) -> IO (acc, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
a -> do
ForeignPtr Word8
gp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
len
acc
acc' <- ForeignPtr Word8 -> (Ptr Word8 -> IO acc) -> IO acc
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
gp ((Ptr Word8 -> IO acc) -> IO acc)
-> (Ptr Word8 -> IO acc) -> IO acc
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> acc -> Int -> Ptr Any -> Ptr Word8 -> IO acc
forall b b. acc -> Int -> Ptr b -> Ptr b -> IO acc
mapAccumL_ acc
acc Int
0 (Ptr Word8
a Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
o) Ptr Word8
p
(acc, ByteString) -> IO (acc, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (acc
acc', ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
gp Int
0 Int
len)
where
mapAccumL_ :: acc -> Int -> Ptr b -> Ptr b -> IO acc
mapAccumL_ !acc
s !Int
n !Ptr b
p1 !Ptr b
p2
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = acc -> IO acc
forall (m :: * -> *) a. Monad m => a -> m a
return acc
s
| Bool
otherwise = do
Word8
x <- Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p1 Int
n
let (acc
s', Word8
y) = acc -> Word8 -> (acc, Word8)
f acc
s Word8
x
Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
p2 Int
n Word8
y
acc -> Int -> Ptr b -> Ptr b -> IO acc
mapAccumL_ acc
s' (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Ptr b
p1 Ptr b
p2
{-# INLINE mapAccumL #-}
mapAccumR :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)
mapAccumR :: (acc -> Word8 -> (acc, Word8))
-> acc -> ByteString -> (acc, ByteString)
mapAccumR acc -> Word8 -> (acc, Word8)
f acc
acc (PS ForeignPtr Word8
fp Int
o Int
len) = IO (acc, ByteString) -> (acc, ByteString)
forall a. IO a -> a
unsafeDupablePerformIO (IO (acc, ByteString) -> (acc, ByteString))
-> IO (acc, ByteString) -> (acc, ByteString)
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8
-> (Ptr Word8 -> IO (acc, ByteString)) -> IO (acc, ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO (acc, ByteString)) -> IO (acc, ByteString))
-> (Ptr Word8 -> IO (acc, ByteString)) -> IO (acc, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
a -> do
ForeignPtr Word8
gp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
len
acc
acc' <- ForeignPtr Word8 -> (Ptr Word8 -> IO acc) -> IO acc
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
gp ((Ptr Word8 -> IO acc) -> IO acc)
-> (Ptr Word8 -> IO acc) -> IO acc
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> acc -> Int -> Ptr Any -> Ptr Word8 -> IO acc
forall b b. acc -> Int -> Ptr b -> Ptr b -> IO acc
mapAccumR_ acc
acc (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Ptr Word8
a Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
o) Ptr Word8
p
(acc, ByteString) -> IO (acc, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return ((acc, ByteString) -> IO (acc, ByteString))
-> (acc, ByteString) -> IO (acc, ByteString)
forall a b. (a -> b) -> a -> b
$! (acc
acc', ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
gp Int
0 Int
len)
where
mapAccumR_ :: acc -> Int -> Ptr b -> Ptr b -> IO acc
mapAccumR_ !acc
s !Int
n !Ptr b
p !Ptr b
q
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = acc -> IO acc
forall (m :: * -> *) a. Monad m => a -> m a
return acc
s
| Bool
otherwise = do
Word8
x <- Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p Int
n
let (acc
s', Word8
y) = acc -> Word8 -> (acc, Word8)
f acc
s Word8
x
Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
q Int
n Word8
y
acc -> Int -> Ptr b -> Ptr b -> IO acc
mapAccumR_ acc
s' (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Ptr b
p Ptr b
q
{-# INLINE mapAccumR #-}
scanl :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
scanl :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
scanl Word8 -> Word8 -> Word8
f Word8
v (PS ForeignPtr Word8
fp Int
s Int
len) = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
a ->
Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
q -> do
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
q Word8
v
Word8 -> Int -> Ptr Any -> Ptr Any -> IO ()
forall b b. Word8 -> Int -> Ptr b -> Ptr b -> IO ()
scanl_ Word8
v Int
0 (Ptr Word8
a Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s) (Ptr Word8
q Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
where
scanl_ :: Word8 -> Int -> Ptr b -> Ptr b -> IO ()
scanl_ !Word8
z !Int
n !Ptr b
p !Ptr b
q
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
Word8
x <- Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p Int
n
let z' :: Word8
z' = Word8 -> Word8 -> Word8
f Word8
z Word8
x
Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
q Int
n Word8
z'
Word8 -> Int -> Ptr b -> Ptr b -> IO ()
scanl_ Word8
z' (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Ptr b
p Ptr b
q
{-# INLINE scanl #-}
scanl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
scanl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
scanl1 Word8 -> Word8 -> Word8
f ByteString
ps
| ByteString -> Bool
null ByteString
ps = ByteString
empty
| Bool
otherwise = (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
scanl Word8 -> Word8 -> Word8
f (ByteString -> Word8
unsafeHead ByteString
ps) (ByteString -> ByteString
unsafeTail ByteString
ps)
{-# INLINE scanl1 #-}
scanr :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
scanr :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
scanr Word8 -> Word8 -> Word8
f Word8
v (PS ForeignPtr Word8
fp Int
s Int
len) = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
a ->
Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
q -> do
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
q Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len) Word8
v
Word8 -> Int -> Ptr Any -> Ptr Word8 -> IO ()
forall b b. Word8 -> Int -> Ptr b -> Ptr b -> IO ()
scanr_ Word8
v (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Ptr Word8
a Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s) Ptr Word8
q
where
scanr_ :: Word8 -> Int -> Ptr b -> Ptr b -> IO ()
scanr_ !Word8
z !Int
n !Ptr b
p !Ptr b
q
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
Word8
x <- Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p Int
n
let z' :: Word8
z' = Word8 -> Word8 -> Word8
f Word8
x Word8
z
Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
q Int
n Word8
z'
Word8 -> Int -> Ptr b -> Ptr b -> IO ()
scanr_ Word8
z' (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Ptr b
p Ptr b
q
{-# INLINE scanr #-}
scanr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
scanr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
scanr1 Word8 -> Word8 -> Word8
f ByteString
ps
| ByteString -> Bool
null ByteString
ps = ByteString
empty
| Bool
otherwise = (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
scanr Word8 -> Word8 -> Word8
f (ByteString -> Word8
unsafeLast ByteString
ps) (ByteString -> ByteString
unsafeInit ByteString
ps)
{-# INLINE scanr1 #-}
replicate :: Int -> Word8 -> ByteString
replicate :: Int -> Word8 -> ByteString
replicate Int
w Word8
c
| Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ByteString
empty
| Bool
otherwise = Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
w ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
memset Ptr Word8
ptr Word8
c (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w) IO (Ptr Word8) -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
unfoldr :: (a -> Maybe (Word8, a)) -> a -> ByteString
unfoldr :: (a -> Maybe (Word8, a)) -> a -> ByteString
unfoldr a -> Maybe (Word8, a)
f = [ByteString] -> ByteString
concat ([ByteString] -> ByteString)
-> (a -> [ByteString]) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> a -> [ByteString]
unfoldChunk Int
32 Int
64
where unfoldChunk :: Int -> Int -> a -> [ByteString]
unfoldChunk Int
n Int
n' a
x =
case Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
unfoldrN Int
n a -> Maybe (Word8, a)
f a
x of
(ByteString
s, Maybe a
Nothing) -> ByteString
s ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: []
(ByteString
s, Just a
x') -> ByteString
s ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: Int -> Int -> a -> [ByteString]
unfoldChunk Int
n' (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n') a
x'
{-# INLINE unfoldr #-}
unfoldrN :: Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
unfoldrN :: Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
unfoldrN Int
i a -> Maybe (Word8, a)
f a
x0
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = (ByteString
empty, a -> Maybe a
forall a. a -> Maybe a
Just a
x0)
| Bool
otherwise = IO (ByteString, Maybe a) -> (ByteString, Maybe a)
forall a. IO a -> a
unsafePerformIO (IO (ByteString, Maybe a) -> (ByteString, Maybe a))
-> IO (ByteString, Maybe a) -> (ByteString, Maybe a)
forall a b. (a -> b) -> a -> b
$ Int
-> (Ptr Word8 -> IO (Int, Int, Maybe a))
-> IO (ByteString, Maybe a)
forall a.
Int -> (Ptr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)
createAndTrim' Int
i ((Ptr Word8 -> IO (Int, Int, Maybe a)) -> IO (ByteString, Maybe a))
-> (Ptr Word8 -> IO (Int, Int, Maybe a))
-> IO (ByteString, Maybe a)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> a -> Int -> IO (Int, Int, Maybe a)
forall a. Num a => Ptr Word8 -> a -> Int -> IO (a, Int, Maybe a)
go Ptr Word8
p a
x0 Int
0
where
go :: Ptr Word8 -> a -> Int -> IO (a, Int, Maybe a)
go !Ptr Word8
p !a
x !Int
n
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i = (a, Int, Maybe a) -> IO (a, Int, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
0, Int
n, a -> Maybe a
forall a. a -> Maybe a
Just a
x)
| Bool
otherwise = case a -> Maybe (Word8, a)
f a
x of
Maybe (Word8, a)
Nothing -> (a, Int, Maybe a) -> IO (a, Int, Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
0, Int
n, Maybe a
forall a. Maybe a
Nothing)
Just (Word8
w,a
x') -> do Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p Word8
w
Ptr Word8 -> a -> Int -> IO (a, Int, Maybe a)
go (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) a
x' (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
{-# INLINE unfoldrN #-}
take :: Int -> ByteString -> ByteString
take :: Int -> ByteString -> ByteString
take Int
n ps :: ByteString
ps@(PS ForeignPtr Word8
x Int
s Int
l)
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ByteString
empty
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l = ByteString
ps
| Bool
otherwise = ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
x Int
s Int
n
{-# INLINE take #-}
drop :: Int -> ByteString -> ByteString
drop :: Int -> ByteString -> ByteString
drop Int
n ps :: ByteString
ps@(PS ForeignPtr Word8
x Int
s Int
l)
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ByteString
ps
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l = ByteString
empty
| Bool
otherwise = ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
x (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n)
{-# INLINE drop #-}
splitAt :: Int -> ByteString -> (ByteString, ByteString)
splitAt :: Int -> ByteString -> (ByteString, ByteString)
splitAt Int
n ps :: ByteString
ps@(PS ForeignPtr Word8
x Int
s Int
l)
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (ByteString
empty, ByteString
ps)
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l = (ByteString
ps, ByteString
empty)
| Bool
otherwise = (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
x Int
s Int
n, ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
x (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n))
{-# INLINE splitAt #-}
takeWhile :: (Word8 -> Bool) -> ByteString -> ByteString
takeWhile :: (Word8 -> Bool) -> ByteString -> ByteString
takeWhile Word8 -> Bool
f ByteString
ps = Int -> ByteString -> ByteString
unsafeTake ((Word8 -> Bool) -> ByteString -> Int
findIndexOrEnd (Bool -> Bool
not (Bool -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Bool
f) ByteString
ps) ByteString
ps
{-# INLINE takeWhile #-}
takeWhileEnd :: (Word8 -> Bool) -> ByteString -> ByteString
takeWhileEnd :: (Word8 -> Bool) -> ByteString -> ByteString
takeWhileEnd Word8 -> Bool
f ByteString
ps = Int -> ByteString -> ByteString
unsafeDrop ((Word8 -> Bool) -> ByteString -> Int
findFromEndUntil (Bool -> Bool
not (Bool -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Bool
f) ByteString
ps) ByteString
ps
{-# INLINE takeWhileEnd #-}
dropWhile :: (Word8 -> Bool) -> ByteString -> ByteString
dropWhile :: (Word8 -> Bool) -> ByteString -> ByteString
dropWhile Word8 -> Bool
f ByteString
ps = Int -> ByteString -> ByteString
unsafeDrop ((Word8 -> Bool) -> ByteString -> Int
findIndexOrEnd (Bool -> Bool
not (Bool -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Bool
f) ByteString
ps) ByteString
ps
{-# INLINE dropWhile #-}
dropWhileEnd :: (Word8 -> Bool) -> ByteString -> ByteString
dropWhileEnd :: (Word8 -> Bool) -> ByteString -> ByteString
dropWhileEnd Word8 -> Bool
f ByteString
ps = Int -> ByteString -> ByteString
unsafeTake ((Word8 -> Bool) -> ByteString -> Int
findFromEndUntil (Bool -> Bool
not (Bool -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Bool
f) ByteString
ps) ByteString
ps
{-# INLINE dropWhileEnd #-}
break :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
break :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
break Word8 -> Bool
p ByteString
ps = case (Word8 -> Bool) -> ByteString -> Int
findIndexOrEnd Word8 -> Bool
p ByteString
ps of Int
n -> (Int -> ByteString -> ByteString
unsafeTake Int
n ByteString
ps, Int -> ByteString -> ByteString
unsafeDrop Int
n ByteString
ps)
{-# INLINE [1] break #-}
#if MIN_VERSION_base(4,9,0)
{-# RULES
"ByteString specialise break (x ==)" forall x.
break (x `eqWord8`) = breakByte x
"ByteString specialise break (== x)" forall x.
break (`eqWord8` x) = breakByte x
#-}
#else
{-# RULES
"ByteString specialise break (x ==)" forall x.
break (x ==) = breakByte x
"ByteString specialise break (== x)" forall x.
break (== x) = breakByte x
#-}
#endif
breakByte :: Word8 -> ByteString -> (ByteString, ByteString)
breakByte :: Word8 -> ByteString -> (ByteString, ByteString)
breakByte Word8
c ByteString
p = case Word8 -> ByteString -> Maybe Int
elemIndex Word8
c ByteString
p of
Maybe Int
Nothing -> (ByteString
p,ByteString
empty)
Just Int
n -> (Int -> ByteString -> ByteString
unsafeTake Int
n ByteString
p, Int -> ByteString -> ByteString
unsafeDrop Int
n ByteString
p)
{-# INLINE breakByte #-}
{-# DEPRECATED breakByte "It is an internal function and should never have been exported. Use 'break (== x)' instead. (There are rewrite rules that handle this special case of 'break'.)" #-}
breakEnd :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
breakEnd :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
breakEnd Word8 -> Bool
p ByteString
ps = Int -> ByteString -> (ByteString, ByteString)
splitAt ((Word8 -> Bool) -> ByteString -> Int
findFromEndUntil Word8 -> Bool
p ByteString
ps) ByteString
ps
span :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
span :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
span Word8 -> Bool
p ByteString
ps = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
break (Bool -> Bool
not (Bool -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Bool
p) ByteString
ps
{-# INLINE [1] span #-}
spanByte :: Word8 -> ByteString -> (ByteString, ByteString)
spanByte :: Word8 -> ByteString -> (ByteString, ByteString)
spanByte Word8
c ps :: ByteString
ps@(PS ForeignPtr Word8
x Int
s Int
l) =
IO (ByteString, ByteString) -> (ByteString, ByteString)
forall a. IO a -> a
accursedUnutterablePerformIO (IO (ByteString, ByteString) -> (ByteString, ByteString))
-> IO (ByteString, ByteString) -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$
ForeignPtr Word8
-> (Ptr Word8 -> IO (ByteString, ByteString))
-> IO (ByteString, ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO (ByteString, ByteString))
-> IO (ByteString, ByteString))
-> (Ptr Word8 -> IO (ByteString, ByteString))
-> IO (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
Ptr Any -> Int -> IO (ByteString, ByteString)
forall b. Ptr b -> Int -> IO (ByteString, ByteString)
go (Ptr Word8
p Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s) Int
0
where
go :: Ptr b -> Int -> IO (ByteString, ByteString)
go !Ptr b
p !Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l = (ByteString, ByteString) -> IO (ByteString, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
ps, ByteString
empty)
| Bool
otherwise = do Word8
c' <- Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p Int
i
if Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
c'
then (ByteString, ByteString) -> IO (ByteString, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ByteString -> ByteString
unsafeTake Int
i ByteString
ps, Int -> ByteString -> ByteString
unsafeDrop Int
i ByteString
ps)
else Ptr b -> Int -> IO (ByteString, ByteString)
go Ptr b
p (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
{-# INLINE spanByte #-}
#if MIN_VERSION_base(4,9,0)
{-# RULES
"ByteString specialise span (x ==)" forall x.
span (x `eqWord8`) = spanByte x
"ByteString specialise span (== x)" forall x.
span (`eqWord8` x) = spanByte x
#-}
#else
{-# RULES
"ByteString specialise span (x ==)" forall x.
span (x ==) = spanByte x
"ByteString specialise span (== x)" forall x.
span (== x) = spanByte x
#-}
#endif
spanEnd :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
spanEnd :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
spanEnd Word8 -> Bool
p ByteString
ps = Int -> ByteString -> (ByteString, ByteString)
splitAt ((Word8 -> Bool) -> ByteString -> Int
findFromEndUntil (Bool -> Bool
not(Bool -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Word8 -> Bool
p) ByteString
ps) ByteString
ps
splitWith :: (Word8 -> Bool) -> ByteString -> [ByteString]
splitWith :: (Word8 -> Bool) -> ByteString -> [ByteString]
splitWith Word8 -> Bool
_pred (PS ForeignPtr Word8
_ Int
_ Int
0) = []
splitWith Word8 -> Bool
pred_ (PS ForeignPtr Word8
fp Int
off Int
len) = (Word# -> Bool) -> Int -> Int -> ForeignPtr Word8 -> [ByteString]
splitWith0 Word# -> Bool
pred# Int
off Int
len ForeignPtr Word8
fp
where pred# :: Word# -> Bool
pred# Word#
c# = Word8 -> Bool
pred_ (Word# -> Word8
W8# Word#
c#)
splitWith0 :: (Word# -> Bool) -> Int -> Int -> ForeignPtr Word8 -> [ByteString]
splitWith0 !Word# -> Bool
pred' !Int
off' !Int
len' !ForeignPtr Word8
fp' =
IO [ByteString] -> [ByteString]
forall a. IO a -> a
accursedUnutterablePerformIO (IO [ByteString] -> [ByteString])
-> IO [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$
ForeignPtr Word8
-> (Ptr Word8 -> IO [ByteString]) -> IO [ByteString]
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO [ByteString]) -> IO [ByteString])
-> (Ptr Word8 -> IO [ByteString]) -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
(Word# -> Bool)
-> Ptr Word8
-> Int
-> Int
-> Int
-> ForeignPtr Word8
-> IO [ByteString]
splitLoop Word# -> Bool
pred' Ptr Word8
p Int
0 Int
off' Int
len' ForeignPtr Word8
fp'
splitLoop :: (Word# -> Bool)
-> Ptr Word8
-> Int -> Int -> Int
-> ForeignPtr Word8
-> IO [ByteString]
splitLoop :: (Word# -> Bool)
-> Ptr Word8
-> Int
-> Int
-> Int
-> ForeignPtr Word8
-> IO [ByteString]
splitLoop Word# -> Bool
pred' Ptr Word8
p Int
idx' Int
off' Int
len' ForeignPtr Word8
fp'
| Int
idx' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len' = [ByteString] -> IO [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return [ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp' Int
off' Int
idx']
| Bool
otherwise = do
Word8
w <- Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
p (Int
off'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
idx')
if Word# -> Bool
pred' (case Word8
w of W8# Word#
w# -> Word#
w#)
then [ByteString] -> IO [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp' Int
off' Int
idx' ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:
(Word# -> Bool) -> Int -> Int -> ForeignPtr Word8 -> [ByteString]
splitWith0 Word# -> Bool
pred' (Int
off'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
idx'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
len'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
idx'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ForeignPtr Word8
fp')
else (Word# -> Bool)
-> Ptr Word8
-> Int
-> Int
-> Int
-> ForeignPtr Word8
-> IO [ByteString]
splitLoop Word# -> Bool
pred' Ptr Word8
p (Int
idx'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
off' Int
len' ForeignPtr Word8
fp'
{-# INLINE splitWith #-}
split :: Word8 -> ByteString -> [ByteString]
split :: Word8 -> ByteString -> [ByteString]
split Word8
_ (PS ForeignPtr Word8
_ Int
_ Int
0) = []
split Word8
w (PS ForeignPtr Word8
x Int
s Int
l) = Int -> [ByteString]
loop Int
0
where
loop :: Int -> [ByteString]
loop !Int
n =
let q :: Ptr Word8
q = IO (Ptr Word8) -> Ptr Word8
forall a. IO a -> a
accursedUnutterablePerformIO (IO (Ptr Word8) -> Ptr Word8) -> IO (Ptr Word8) -> Ptr Word8
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO (Ptr Word8)) -> IO (Ptr Word8)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO (Ptr Word8)) -> IO (Ptr Word8))
-> (Ptr Word8 -> IO (Ptr Word8)) -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
memchr (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n))
Word8
w (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n))
in if Ptr Word8
q Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
forall a. Ptr a
nullPtr
then [ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
x (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n)]
else let i :: Int
i = IO Int -> Int
forall a. IO a -> a
accursedUnutterablePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO Int) -> IO Int)
-> (Ptr Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8
q Ptr Word8 -> Ptr Any -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` (Ptr Word8
p Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s))
in ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
x (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n) ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: Int -> [ByteString]
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
{-# INLINE split #-}
group :: ByteString -> [ByteString]
group :: ByteString -> [ByteString]
group ByteString
xs
| ByteString -> Bool
null ByteString
xs = []
| Bool
otherwise = ByteString
ys ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString]
group ByteString
zs
where
(ByteString
ys, ByteString
zs) = Word8 -> ByteString -> (ByteString, ByteString)
spanByte (ByteString -> Word8
unsafeHead ByteString
xs) ByteString
xs
groupBy :: (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString]
groupBy :: (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString]
groupBy Word8 -> Word8 -> Bool
k ByteString
xs
| ByteString -> Bool
null ByteString
xs = []
| Bool
otherwise = Int -> ByteString -> ByteString
unsafeTake Int
n ByteString
xs ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString]
groupBy Word8 -> Word8 -> Bool
k (Int -> ByteString -> ByteString
unsafeDrop Int
n ByteString
xs)
where
n :: Int
n = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Word8 -> Bool) -> ByteString -> Int
findIndexOrEnd (Bool -> Bool
not (Bool -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word8 -> Bool
k (ByteString -> Word8
unsafeHead ByteString
xs)) (ByteString -> ByteString
unsafeTail ByteString
xs)
intercalate :: ByteString -> [ByteString] -> ByteString
intercalate :: ByteString -> [ByteString] -> ByteString
intercalate ByteString
s = [ByteString] -> ByteString
concat ([ByteString] -> ByteString)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
List.intersperse ByteString
s
{-# INLINE [1] intercalate #-}
{-# RULES
"ByteString specialise intercalate c -> intercalateByte" forall c s1 s2 .
intercalate (singleton c) [s1, s2] = intercalateWithByte c s1 s2
#-}
intercalateWithByte :: Word8 -> ByteString -> ByteString -> ByteString
intercalateWithByte :: Word8 -> ByteString -> ByteString -> ByteString
intercalateWithByte Word8
c f :: ByteString
f@(PS ForeignPtr Word8
ffp Int
s Int
l) g :: ByteString
g@(PS ForeignPtr Word8
fgp Int
t Int
m) = Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
len ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
ffp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
fp ->
ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fgp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
gp -> do
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
ptr (Ptr Word8
fp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s) (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
l) Word8
c
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) (Ptr Word8
gp Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
t) (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m)
where
len :: Int
len = ByteString -> Int
length ByteString
f Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
length ByteString
g Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
{-# INLINE intercalateWithByte #-}
index :: ByteString -> Int -> Word8
index :: ByteString -> Int -> Word8
index ByteString
ps Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> String -> Word8
forall a. String -> String -> a
moduleError String
"index" (String
"negative index: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= ByteString -> Int
length ByteString
ps = String -> String -> Word8
forall a. String -> String -> a
moduleError String
"index" (String
"index too large: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", length = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
length ByteString
ps))
| Bool
otherwise = ByteString
ps ByteString -> Int -> Word8
`unsafeIndex` Int
n
{-# INLINE index #-}
elemIndex :: Word8 -> ByteString -> Maybe Int
elemIndex :: Word8 -> ByteString -> Maybe Int
elemIndex Word8
c (PS ForeignPtr Word8
x Int
s Int
l) = IO (Maybe Int) -> Maybe Int
forall a. IO a -> a
accursedUnutterablePerformIO (IO (Maybe Int) -> Maybe Int) -> IO (Maybe Int) -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int))
-> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
let p' :: Ptr b
p' = Ptr Word8
p Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s
Ptr Word8
q <- Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
memchr Ptr Word8
forall a. Ptr a
p' Word8
c (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> IO (Maybe Int)) -> Maybe Int -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$! if Ptr Word8
q Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
forall a. Ptr a
nullPtr then Maybe Int
forall a. Maybe a
Nothing else Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$! Ptr Word8
q Ptr Word8 -> Ptr Any -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Any
forall a. Ptr a
p'
{-# INLINE elemIndex #-}
elemIndexEnd :: Word8 -> ByteString -> Maybe Int
elemIndexEnd :: Word8 -> ByteString -> Maybe Int
elemIndexEnd = (Word8 -> Bool) -> ByteString -> Maybe Int
findIndexEnd ((Word8 -> Bool) -> ByteString -> Maybe Int)
-> (Word8 -> Word8 -> Bool) -> Word8 -> ByteString -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
(==)
{-# INLINE elemIndexEnd #-}
elemIndices :: Word8 -> ByteString -> [Int]
elemIndices :: Word8 -> ByteString -> [Int]
elemIndices Word8
w (PS ForeignPtr Word8
x Int
s Int
l) = Int -> [Int]
loop Int
0
where
loop :: Int -> [Int]
loop !Int
n = let q :: Ptr Word8
q = IO (Ptr Word8) -> Ptr Word8
forall a. IO a -> a
accursedUnutterablePerformIO (IO (Ptr Word8) -> Ptr Word8) -> IO (Ptr Word8) -> Ptr Word8
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO (Ptr Word8)) -> IO (Ptr Word8)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO (Ptr Word8)) -> IO (Ptr Word8))
-> (Ptr Word8 -> IO (Ptr Word8)) -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
memchr (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
s))
Word8
w (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n))
in if Ptr Word8
q Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
forall a. Ptr a
nullPtr
then []
else let i :: Int
i = IO Int -> Int
forall a. IO a -> a
accursedUnutterablePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO Int) -> IO Int)
-> (Ptr Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8
q Ptr Word8 -> Ptr Any -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` (Ptr Word8
p Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s))
in Int
i Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int -> [Int]
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
{-# INLINE elemIndices #-}
count :: Word8 -> ByteString -> Int
count :: Word8 -> ByteString -> Int
count Word8
w (PS ForeignPtr Word8
x Int
s Int
m) = IO Int -> Int
forall a. IO a -> a
accursedUnutterablePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO Int) -> IO Int)
-> (Ptr Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
(CULong -> Int) -> IO CULong -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CULong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CULong -> IO Int) -> IO CULong -> IO Int
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> CULong -> Word8 -> IO CULong
c_count (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s) (Int -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m) Word8
w
{-# INLINE count #-}
findIndex :: (Word8 -> Bool) -> ByteString -> Maybe Int
findIndex :: (Word8 -> Bool) -> ByteString -> Maybe Int
findIndex Word8 -> Bool
k (PS ForeignPtr Word8
x Int
s Int
l) = IO (Maybe Int) -> Maybe Int
forall a. IO a -> a
accursedUnutterablePerformIO (IO (Maybe Int) -> Maybe Int) -> IO (Maybe Int) -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int))
-> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
f -> Ptr Word8 -> Int -> IO (Maybe Int)
go (Ptr Word8
f Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s) Int
0
where
go :: Ptr Word8 -> Int -> IO (Maybe Int)
go !Ptr Word8
ptr !Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l = Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
| Bool
otherwise = do Word8
w <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr
if Word8 -> Bool
k Word8
w
then Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n)
else Ptr Word8 -> Int -> IO (Maybe Int)
go (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
{-# INLINE findIndex #-}
findIndexEnd :: (Word8 -> Bool) -> ByteString -> Maybe Int
findIndexEnd :: (Word8 -> Bool) -> ByteString -> Maybe Int
findIndexEnd Word8 -> Bool
k (PS ForeignPtr Word8
x Int
s Int
l) = IO (Maybe Int) -> Maybe Int
forall a. IO a -> a
accursedUnutterablePerformIO (IO (Maybe Int) -> Maybe Int) -> IO (Maybe Int) -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int))
-> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
f -> Ptr Any -> Int -> IO (Maybe Int)
forall b. Ptr b -> Int -> IO (Maybe Int)
go (Ptr Word8
f Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
where
go :: Ptr b -> Int -> IO (Maybe Int)
go !Ptr b
ptr !Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
| Bool
otherwise = do Word8
w <- Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
n
if Word8 -> Bool
k Word8
w
then Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n)
else Ptr b -> Int -> IO (Maybe Int)
go Ptr b
ptr (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
{-# INLINE findIndexEnd #-}
findIndices :: (Word8 -> Bool) -> ByteString -> [Int]
findIndices :: (Word8 -> Bool) -> ByteString -> [Int]
findIndices Word8 -> Bool
p ByteString
ps = Int -> ByteString -> [Int]
forall a. Num a => a -> ByteString -> [a]
loop Int
0 ByteString
ps
where
loop :: a -> ByteString -> [a]
loop !a
n !ByteString
qs | ByteString -> Bool
null ByteString
qs = []
| Word8 -> Bool
p (ByteString -> Word8
unsafeHead ByteString
qs) = a
n a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> ByteString -> [a]
loop (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
1) (ByteString -> ByteString
unsafeTail ByteString
qs)
| Bool
otherwise = a -> ByteString -> [a]
loop (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
1) (ByteString -> ByteString
unsafeTail ByteString
qs)
elem :: Word8 -> ByteString -> Bool
elem :: Word8 -> ByteString -> Bool
elem Word8
c ByteString
ps = case Word8 -> ByteString -> Maybe Int
elemIndex Word8
c ByteString
ps of Maybe Int
Nothing -> Bool
False ; Maybe Int
_ -> Bool
True
{-# INLINE elem #-}
notElem :: Word8 -> ByteString -> Bool
notElem :: Word8 -> ByteString -> Bool
notElem Word8
c ByteString
ps = Bool -> Bool
not (Word8 -> ByteString -> Bool
elem Word8
c ByteString
ps)
{-# INLINE notElem #-}
filter :: (Word8 -> Bool) -> ByteString -> ByteString
filter :: (Word8 -> Bool) -> ByteString -> ByteString
filter Word8 -> Bool
k ps :: ByteString
ps@(PS ForeignPtr Word8
x Int
s Int
l)
| ByteString -> Bool
null ByteString
ps = ByteString
ps
| Bool
otherwise = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr Word8 -> IO Int) -> IO ByteString
createAndTrim Int
l ((Ptr Word8 -> IO Int) -> IO ByteString)
-> (Ptr Word8 -> IO Int) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> ForeignPtr Word8 -> (Ptr Word8 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO Int) -> IO Int)
-> (Ptr Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
f -> do
Ptr Word8
t <- Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
go (Ptr Word8
f Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s) Ptr Word8
p (Ptr Word8
f Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l))
Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$! Ptr Word8
t Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
p
where
go :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
go !Ptr Word8
f !Ptr Word8
t !Ptr Word8
end | Ptr Word8
f Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
end = Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Word8
t
| Bool
otherwise = do
Word8
w <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
f
if Word8 -> Bool
k Word8
w
then Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
t Word8
w IO () -> IO (Ptr Word8) -> IO (Ptr Word8)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
go (Ptr Word8
f Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Ptr Word8
t Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Ptr Word8
end
else Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
go (Ptr Word8
f Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Ptr Word8
t Ptr Word8
end
{-# INLINE filter #-}
find :: (Word8 -> Bool) -> ByteString -> Maybe Word8
find :: (Word8 -> Bool) -> ByteString -> Maybe Word8
find Word8 -> Bool
f ByteString
p = case (Word8 -> Bool) -> ByteString -> Maybe Int
findIndex Word8 -> Bool
f ByteString
p of
Just Int
n -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (ByteString
p ByteString -> Int -> Word8
`unsafeIndex` Int
n)
Maybe Int
_ -> Maybe Word8
forall a. Maybe a
Nothing
{-# INLINE find #-}
partition :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
partition :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
partition Word8 -> Bool
f ByteString
s = IO (ByteString, ByteString) -> (ByteString, ByteString)
forall a. IO a -> a
unsafeDupablePerformIO (IO (ByteString, ByteString) -> (ByteString, ByteString))
-> IO (ByteString, ByteString) -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$
do ForeignPtr Word8
fp' <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
len
ForeignPtr Word8
-> (Ptr Word8 -> IO (ByteString, ByteString))
-> IO (ByteString, ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp' ((Ptr Word8 -> IO (ByteString, ByteString))
-> IO (ByteString, ByteString))
-> (Ptr Word8 -> IO (ByteString, ByteString))
-> IO (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
do let end :: Ptr b
end = Ptr Word8
p Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
Ptr Word8
mid <- Int -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
sep Int
0 Ptr Word8
p Ptr Word8
forall a. Ptr a
end
Ptr Word8 -> Ptr Word8 -> IO ()
forall b. Storable b => Ptr b -> Ptr b -> IO ()
rev Ptr Word8
mid Ptr Word8
forall a. Ptr a
end
let i :: Int
i = Ptr Word8
mid Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
p
(ByteString, ByteString) -> IO (ByteString, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp' Int
0 Int
i,
ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp' Int
i (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i))
where
len :: Int
len = ByteString -> Int
length ByteString
s
incr :: Ptr a -> Ptr b
incr = (Ptr a -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
decr :: Ptr a -> Ptr b
decr = (Ptr a -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1))
sep :: Int -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
sep !Int
i !Ptr Word8
p1 !Ptr Word8
p2
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len = Ptr Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Word8
p1
| Word8 -> Bool
f Word8
w = do Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p1 Word8
w
Int -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
sep (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Ptr Word8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
incr Ptr Word8
p1) Ptr Word8
p2
| Bool
otherwise = do Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p2 Word8
w
Int -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)
sep (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Ptr Word8
p1 (Ptr Word8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
decr Ptr Word8
p2)
where
w :: Word8
w = ByteString
s ByteString -> Int -> Word8
`unsafeIndex` Int
i
rev :: Ptr b -> Ptr b -> IO ()
rev !Ptr b
p1 !Ptr b
p2
| Ptr b
p1 Ptr b -> Ptr b -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr b
p2 = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do b
a <- Ptr b -> IO b
forall a. Storable a => Ptr a -> IO a
peek Ptr b
p1
b
b <- Ptr b -> IO b
forall a. Storable a => Ptr a -> IO a
peek Ptr b
p2
Ptr b -> b -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr b
p1 b
b
Ptr b -> b -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr b
p2 b
a
Ptr b -> Ptr b -> IO ()
rev (Ptr b -> Ptr b
forall a b. Ptr a -> Ptr b
incr Ptr b
p1) (Ptr b -> Ptr b
forall a b. Ptr a -> Ptr b
decr Ptr b
p2)
isPrefixOf :: ByteString -> ByteString -> Bool
isPrefixOf :: ByteString -> ByteString -> Bool
isPrefixOf (PS ForeignPtr Word8
x1 Int
s1 Int
l1) (PS ForeignPtr Word8
x2 Int
s2 Int
l2)
| Int
l1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Bool
True
| Int
l2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l1 = Bool
False
| Bool
otherwise = IO Bool -> Bool
forall a. IO a -> a
accursedUnutterablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x1 ((Ptr Word8 -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p1 ->
ForeignPtr Word8 -> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x2 ((Ptr Word8 -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p2 -> do
CInt
i <- Ptr Word8 -> Ptr Word8 -> Int -> IO CInt
memcmp (Ptr Word8
p1 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s1) (Ptr Word8
p2 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s2) (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l1)
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$! CInt
i CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
stripPrefix :: ByteString -> ByteString -> Maybe ByteString
stripPrefix :: ByteString -> ByteString -> Maybe ByteString
stripPrefix bs1 :: ByteString
bs1@(PS ForeignPtr Word8
_ Int
_ Int
l1) ByteString
bs2
| ByteString
bs1 ByteString -> ByteString -> Bool
`isPrefixOf` ByteString
bs2 = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Int -> ByteString -> ByteString
unsafeDrop Int
l1 ByteString
bs2)
| Bool
otherwise = Maybe ByteString
forall a. Maybe a
Nothing
isSuffixOf :: ByteString -> ByteString -> Bool
isSuffixOf :: ByteString -> ByteString -> Bool
isSuffixOf (PS ForeignPtr Word8
x1 Int
s1 Int
l1) (PS ForeignPtr Word8
x2 Int
s2 Int
l2)
| Int
l1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Bool
True
| Int
l2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l1 = Bool
False
| Bool
otherwise = IO Bool -> Bool
forall a. IO a -> a
accursedUnutterablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x1 ((Ptr Word8 -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p1 ->
ForeignPtr Word8 -> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x2 ((Ptr Word8 -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p2 -> do
CInt
i <- Ptr Word8 -> Ptr Word8 -> Int -> IO CInt
memcmp (Ptr Word8
p1 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s1) (Ptr Word8
p2 Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s2 Ptr Any -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
l2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l1)) (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l1)
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$! CInt
i CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
stripSuffix :: ByteString -> ByteString -> Maybe ByteString
stripSuffix :: ByteString -> ByteString -> Maybe ByteString
stripSuffix bs1 :: ByteString
bs1@(PS ForeignPtr Word8
_ Int
_ Int
l1) bs2 :: ByteString
bs2@(PS ForeignPtr Word8
_ Int
_ Int
l2)
| ByteString
bs1 ByteString -> ByteString -> Bool
`isSuffixOf` ByteString
bs2 = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Int -> ByteString -> ByteString
unsafeTake (Int
l2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l1) ByteString
bs2)
| Bool
otherwise = Maybe ByteString
forall a. Maybe a
Nothing
isInfixOf :: ByteString -> ByteString -> Bool
isInfixOf :: ByteString -> ByteString -> Bool
isInfixOf ByteString
p ByteString
s = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (ByteString -> ByteString -> Maybe Int
findSubstring ByteString
p ByteString
s)
breakSubstring :: ByteString
-> ByteString
-> (ByteString,ByteString)
breakSubstring :: ByteString -> ByteString -> (ByteString, ByteString)
breakSubstring ByteString
pat =
case Int
lp of
Int
0 -> \ByteString
src -> (ByteString
empty,ByteString
src)
Int
1 -> Word8 -> ByteString -> (ByteString, ByteString)
breakByte (ByteString -> Word8
unsafeHead ByteString
pat)
Int
_ -> if Int
lp Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Word -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Word
0 :: Word)
then ByteString -> (ByteString, ByteString)
shift
else ByteString -> (ByteString, ByteString)
karpRabin
where
unsafeSplitAt :: Int -> ByteString -> (ByteString, ByteString)
unsafeSplitAt Int
i ByteString
s = (Int -> ByteString -> ByteString
unsafeTake Int
i ByteString
s, Int -> ByteString -> ByteString
unsafeDrop Int
i ByteString
s)
lp :: Int
lp = ByteString -> Int
length ByteString
pat
karpRabin :: ByteString -> (ByteString, ByteString)
karpRabin :: ByteString -> (ByteString, ByteString)
karpRabin ByteString
src
| ByteString -> Int
length ByteString
src Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lp = (ByteString
src,ByteString
empty)
| Bool
otherwise = Word32 -> Int -> (ByteString, ByteString)
search (ByteString -> Word32
rollingHash (ByteString -> Word32) -> ByteString -> Word32
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
unsafeTake Int
lp ByteString
src) Int
lp
where
k :: Word32
k = Word32
2891336453 :: Word32
rollingHash :: ByteString -> Word32
rollingHash = (Word32 -> Word8 -> Word32) -> Word32 -> ByteString -> Word32
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
foldl' (\Word32
h Word8
b -> Word32
h Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
k Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) Word32
0
hp :: Word32
hp = ByteString -> Word32
rollingHash ByteString
pat
m :: Word32
m = Word32
k Word32 -> Int -> Word32
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
lp
get :: Int -> Word32
get = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> (Int -> Word8) -> Int -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int -> Word8
unsafeIndex ByteString
src
search :: Word32 -> Int -> (ByteString, ByteString)
search !Word32
hs !Int
i
| Word32
hp Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
hs Bool -> Bool -> Bool
&& ByteString
pat ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> ByteString -> ByteString
unsafeTake Int
lp ByteString
b = (ByteString, ByteString)
u
| ByteString -> Int
length ByteString
src Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i = (ByteString
src,ByteString
empty)
| Bool
otherwise = Word32 -> Int -> (ByteString, ByteString)
search Word32
hs' (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
where
u :: (ByteString, ByteString)
u@(ByteString
_, ByteString
b) = Int -> ByteString -> (ByteString, ByteString)
unsafeSplitAt (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lp) ByteString
src
hs' :: Word32
hs' = Word32
hs Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
k Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+
Int -> Word32
get Int
i Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
-
Word32
m Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Int -> Word32
get (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lp)
{-# INLINE karpRabin #-}
shift :: ByteString -> (ByteString, ByteString)
shift :: ByteString -> (ByteString, ByteString)
shift !ByteString
src
| ByteString -> Int
length ByteString
src Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lp = (ByteString
src,ByteString
empty)
| Bool
otherwise = Word -> Int -> (ByteString, ByteString)
search (ByteString -> Word
intoWord (ByteString -> Word) -> ByteString -> Word
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
unsafeTake Int
lp ByteString
src) Int
lp
where
intoWord :: ByteString -> Word
intoWord :: ByteString -> Word
intoWord = (Word -> Word8 -> Word) -> Word -> ByteString -> Word
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
foldl' (\Word
w Word8
b -> (Word
w Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) Word
0
wp :: Word
wp = ByteString -> Word
intoWord ByteString
pat
mask :: Word
mask = (Word
1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
lp)) Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1
search :: Word -> Int -> (ByteString, ByteString)
search !Word
w !Int
i
| Word
w Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
wp = Int -> ByteString -> (ByteString, ByteString)
unsafeSplitAt (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lp) ByteString
src
| ByteString -> Int
length ByteString
src Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i = (ByteString
src, ByteString
empty)
| Bool
otherwise = Word -> Int -> (ByteString, ByteString)
search Word
w' (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
where
b :: Word
b = Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
unsafeIndex ByteString
src Int
i)
w' :: Word
w' = Word
mask Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. ((Word
w Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word
b)
{-# INLINE shift #-}
findSubstring :: ByteString
-> ByteString
-> Maybe Int
findSubstring :: ByteString -> ByteString -> Maybe Int
findSubstring ByteString
pat ByteString
src
| ByteString -> Bool
null ByteString
pat Bool -> Bool -> Bool
&& ByteString -> Bool
null ByteString
src = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
| ByteString -> Bool
null ByteString
b = Maybe Int
forall a. Maybe a
Nothing
| Bool
otherwise = Int -> Maybe Int
forall a. a -> Maybe a
Just (ByteString -> Int
length ByteString
a)
where (ByteString
a, ByteString
b) = ByteString -> ByteString -> (ByteString, ByteString)
breakSubstring ByteString
pat ByteString
src
{-# DEPRECATED findSubstring "findSubstring is deprecated in favour of breakSubstring." #-}
findSubstrings :: ByteString
-> ByteString
-> [Int]
findSubstrings :: ByteString -> ByteString -> [Int]
findSubstrings ByteString
pat ByteString
src
| ByteString -> Bool
null ByteString
pat = [Int
0 .. Int
ls]
| Bool
otherwise = Int -> [Int]
search Int
0
where
lp :: Int
lp = ByteString -> Int
length ByteString
pat
ls :: Int
ls = ByteString -> Int
length ByteString
src
search :: Int -> [Int]
search !Int
n
| (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
ls Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lp) Bool -> Bool -> Bool
|| ByteString -> Bool
null ByteString
b = []
| Bool
otherwise = let k :: Int
k = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
length ByteString
a
in Int
k Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int -> [Int]
search (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lp)
where
(ByteString
a, ByteString
b) = ByteString -> ByteString -> (ByteString, ByteString)
breakSubstring ByteString
pat (Int -> ByteString -> ByteString
unsafeDrop Int
n ByteString
src)
{-# DEPRECATED findSubstrings "findSubstrings is deprecated in favour of breakSubstring." #-}
zip :: ByteString -> ByteString -> [(Word8,Word8)]
zip :: ByteString -> ByteString -> [(Word8, Word8)]
zip ByteString
ps ByteString
qs
| ByteString -> Bool
null ByteString
ps Bool -> Bool -> Bool
|| ByteString -> Bool
null ByteString
qs = []
| Bool
otherwise = (ByteString -> Word8
unsafeHead ByteString
ps, ByteString -> Word8
unsafeHead ByteString
qs) (Word8, Word8) -> [(Word8, Word8)] -> [(Word8, Word8)]
forall a. a -> [a] -> [a]
: ByteString -> ByteString -> [(Word8, Word8)]
zip (ByteString -> ByteString
unsafeTail ByteString
ps) (ByteString -> ByteString
unsafeTail ByteString
qs)
zipWith :: (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
zipWith :: (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
zipWith Word8 -> Word8 -> a
f ByteString
ps ByteString
qs
| ByteString -> Bool
null ByteString
ps Bool -> Bool -> Bool
|| ByteString -> Bool
null ByteString
qs = []
| Bool
otherwise = Word8 -> Word8 -> a
f (ByteString -> Word8
unsafeHead ByteString
ps) (ByteString -> Word8
unsafeHead ByteString
qs) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
forall a. (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
zipWith Word8 -> Word8 -> a
f (ByteString -> ByteString
unsafeTail ByteString
ps) (ByteString -> ByteString
unsafeTail ByteString
qs)
{-# NOINLINE [1] zipWith #-}
zipWith' :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> ByteString
zipWith' :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> ByteString
zipWith' Word8 -> Word8 -> Word8
f (PS ForeignPtr Word8
fp Int
s Int
l) (PS ForeignPtr Word8
fq Int
t Int
m) = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
ForeignPtr Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
a ->
ForeignPtr Word8 -> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fq ((Ptr Word8 -> IO ByteString) -> IO ByteString)
-> (Ptr Word8 -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
b ->
Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
len ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()
zipWith_ Int
0 (Ptr Word8
a Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s) (Ptr Word8
b Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
t)
where
zipWith_ :: Int -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()
zipWith_ :: Int -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()
zipWith_ !Int
n !Ptr Word8
p1 !Ptr Word8
p2 !Ptr Word8
r
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
Word8
x <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
p1 Int
n
Word8
y <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
p2 Int
n
Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
r Int
n (Word8 -> Word8 -> Word8
f Word8
x Word8
y)
Int -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()
zipWith_ (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Ptr Word8
p1 Ptr Word8
p2 Ptr Word8
r
len :: Int
len = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
l Int
m
{-# INLINE zipWith' #-}
{-# RULES
"ByteString specialise zipWith" forall (f :: Word8 -> Word8 -> Word8) p q .
zipWith f p q = unpack (zipWith' f p q)
#-}
unzip :: [(Word8,Word8)] -> (ByteString,ByteString)
unzip :: [(Word8, Word8)] -> (ByteString, ByteString)
unzip [(Word8, Word8)]
ls = ([Word8] -> ByteString
pack (((Word8, Word8) -> Word8) -> [(Word8, Word8)] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
P.map (Word8, Word8) -> Word8
forall a b. (a, b) -> a
fst [(Word8, Word8)]
ls), [Word8] -> ByteString
pack (((Word8, Word8) -> Word8) -> [(Word8, Word8)] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
P.map (Word8, Word8) -> Word8
forall a b. (a, b) -> b
snd [(Word8, Word8)]
ls))
{-# INLINE unzip #-}
inits :: ByteString -> [ByteString]
inits :: ByteString -> [ByteString]
inits (PS ForeignPtr Word8
x Int
s Int
l) = [ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
x Int
s Int
n | Int
n <- [Int
0..Int
l]]
tails :: ByteString -> [ByteString]
tails :: ByteString -> [ByteString]
tails ByteString
p | ByteString -> Bool
null ByteString
p = [ByteString
empty]
| Bool
otherwise = ByteString
p ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString]
tails (ByteString -> ByteString
unsafeTail ByteString
p)
sort :: ByteString -> ByteString
sort :: ByteString -> ByteString
sort (PS ForeignPtr Word8
input Int
s Int
l) = Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
l ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Int -> (Ptr CSize -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
256 ((Ptr CSize -> IO ()) -> IO ()) -> (Ptr CSize -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
arr -> do
Ptr Word8
_ <- Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
memset (Ptr CSize -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CSize
arr) Word8
0 (CSize
256 CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
* Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int
forall a. Storable a => a -> Int
sizeOf (CSize
forall a. (?callStack::CallStack) => a
undefined :: CSize)))
ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
input (\Ptr Word8
x -> Ptr CSize -> Ptr Word8 -> Int -> IO ()
countOccurrences Ptr CSize
arr (Ptr Word8
x Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s) Int
l)
let go :: Int -> Ptr Word8 -> IO ()
go Int
256 !Ptr Word8
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
go Int
i !Ptr Word8
ptr = do CSize
n <- Ptr CSize -> Int -> IO CSize
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CSize
arr Int
i
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CSize
n CSize -> CSize -> Bool
forall a. Eq a => a -> a -> Bool
/= CSize
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
memset Ptr Word8
ptr (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i) CSize
n IO (Ptr Word8) -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Int -> Ptr Word8 -> IO ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
n)
Int -> Ptr Word8 -> IO ()
go Int
0 Ptr Word8
p
where
countOccurrences :: Ptr CSize -> Ptr Word8 -> Int -> IO ()
countOccurrences :: Ptr CSize -> Ptr Word8 -> Int -> IO ()
countOccurrences !Ptr CSize
counts !Ptr Word8
str !Int
len = Int -> IO ()
go Int
0
where
go :: Int -> IO ()
go !Int
i | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do Int
k <- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> IO Word8 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
str Int
i
CSize
x <- Ptr CSize -> Int -> IO CSize
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr CSize
counts Int
k
Ptr CSize -> Int -> CSize -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr CSize
counts Int
k (CSize
x CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
+ CSize
1)
Int -> IO ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
useAsCString :: ByteString -> (CString -> IO a) -> IO a
useAsCString :: ByteString -> (CString -> IO a) -> IO a
useAsCString (PS ForeignPtr Word8
fp Int
o Int
l) CString -> IO a
action =
Int -> (Ptr Word8 -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ((Ptr Word8 -> IO a) -> IO a) -> (Ptr Word8 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
buf ->
ForeignPtr Word8 -> (Ptr Word8 -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO a) -> IO a) -> (Ptr Word8 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
buf (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
o) (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
buf Int
l (Word8
0::Word8)
CString -> IO a
action (Ptr Word8 -> CString
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
buf)
useAsCStringLen :: ByteString -> (CStringLen -> IO a) -> IO a
useAsCStringLen :: ByteString -> (CStringLen -> IO a) -> IO a
useAsCStringLen p :: ByteString
p@(PS ForeignPtr Word8
_ Int
_ Int
l) CStringLen -> IO a
f = ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString ByteString
p ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
cstr -> CStringLen -> IO a
f (CString
cstr,Int
l)
packCString :: CString -> IO ByteString
packCString :: CString -> IO ByteString
packCString CString
cstr = do
CSize
len <- CString -> IO CSize
c_strlen CString
cstr
CStringLen -> IO ByteString
packCStringLen (CString
cstr, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
len)
packCStringLen :: CStringLen -> IO ByteString
packCStringLen :: CStringLen -> IO ByteString
packCStringLen (CString
cstr, Int
len) | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
len ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
p (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
cstr) (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
packCStringLen (CString
_, Int
len) =
String -> String -> IO ByteString
forall a. String -> String -> IO a
moduleErrorIO String
"packCStringLen" (String
"negative length: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
len)
copy :: ByteString -> ByteString
copy :: ByteString -> ByteString
copy (PS ForeignPtr Word8
x Int
s Int
l) = Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
l ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
f ->
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
p (Ptr Word8
f Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s) (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
getLine :: IO ByteString
getLine :: IO ByteString
getLine = Handle -> IO ByteString
hGetLine Handle
stdin
hGetLine :: Handle -> IO ByteString
hGetLine :: Handle -> IO ByteString
hGetLine Handle
h =
String -> Handle -> (Handle__ -> IO ByteString) -> IO ByteString
forall a. String -> Handle -> (Handle__ -> IO a) -> IO a
wantReadableHandle_ String
"Data.ByteString.hGetLine" Handle
h ((Handle__ -> IO ByteString) -> IO ByteString)
-> (Handle__ -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$
\ h_ :: Handle__
h_@Handle__{IORef (Buffer Word8)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haByteBuffer :: IORef (Buffer Word8)
haByteBuffer} -> do
Handle__ -> IO ()
flushCharReadBuffer Handle__
h_
Buffer Word8
buf <- IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
if Buffer Word8 -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer Word8
buf
then Handle__ -> Buffer Word8 -> Int -> [ByteString] -> IO ByteString
fill Handle__
h_ Buffer Word8
buf Int
0 []
else Handle__ -> Buffer Word8 -> Int -> [ByteString] -> IO ByteString
haveBuf Handle__
h_ Buffer Word8
buf Int
0 []
where
fill :: Handle__ -> Buffer Word8 -> Int -> [ByteString] -> IO ByteString
fill h_ :: Handle__
h_@Handle__{IORef (Buffer Word8)
haByteBuffer :: IORef (Buffer Word8)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haByteBuffer,dev
haDevice :: ()
haDevice :: dev
haDevice} Buffer Word8
buf !Int
len [ByteString]
xss = do
(Int
r,Buffer Word8
buf') <- dev -> Buffer Word8 -> IO (Int, Buffer Word8)
forall dev.
BufferedIO dev =>
dev -> Buffer Word8 -> IO (Int, Buffer Word8)
Buffered.fillReadBuffer dev
haDevice Buffer Word8
buf
if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then do IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
buf{ bufR :: Int
bufR=Int
0, bufL :: Int
bufL=Int
0 }
if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then Int -> [ByteString] -> IO ByteString
mkBigPS Int
len [ByteString]
xss
else IO ByteString
forall a. IO a
ioe_EOF
else Handle__ -> Buffer Word8 -> Int -> [ByteString] -> IO ByteString
haveBuf Handle__
h_ Buffer Word8
buf' Int
len [ByteString]
xss
haveBuf :: Handle__ -> Buffer Word8 -> Int -> [ByteString] -> IO ByteString
haveBuf h_ :: Handle__
h_@Handle__{IORef (Buffer Word8)
haByteBuffer :: IORef (Buffer Word8)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haByteBuffer}
buf :: Buffer Word8
buf@Buffer{ bufRaw=raw, bufR=w, bufL=r }
Int
len [ByteString]
xss =
do
Int
off <- Int -> Int -> ForeignPtr Word8 -> IO Int
findEOL Int
r Int
w ForeignPtr Word8
raw
let new_len :: Int
new_len = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r
ByteString
xs <- ForeignPtr Word8 -> Int -> Int -> IO ByteString
mkPS ForeignPtr Word8
raw Int
r Int
off
if Int
off Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
w
then do if Int
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
then IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
buf{ bufL :: Int
bufL=Int
0, bufR :: Int
bufR=Int
0 }
else IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
buf{ bufL :: Int
bufL = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
Int -> [ByteString] -> IO ByteString
mkBigPS Int
new_len (ByteString
xsByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
xss)
else Handle__ -> Buffer Word8 -> Int -> [ByteString] -> IO ByteString
fill Handle__
h_ Buffer Word8
buf{ bufL :: Int
bufL=Int
0, bufR :: Int
bufR=Int
0 } Int
new_len (ByteString
xsByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
xss)
findEOL :: Int -> Int -> ForeignPtr Word8 -> IO Int
findEOL Int
r Int
w ForeignPtr Word8
raw
| Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
w = Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
w
| Bool
otherwise = do
Word8
c <- ForeignPtr Word8 -> Int -> IO Word8
readWord8Buf ForeignPtr Word8
raw Int
r
if Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
'\n')
then Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
r
else Int -> Int -> ForeignPtr Word8 -> IO Int
findEOL (Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
w ForeignPtr Word8
raw
mkPS :: RawBuffer Word8 -> Int -> Int -> IO ByteString
mkPS :: ForeignPtr Word8 -> Int -> Int -> IO ByteString
mkPS ForeignPtr Word8
buf Int
start Int
end =
Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
len ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withRawBuffer ForeignPtr Word8
buf ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
pbuf -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
p (Ptr Word8
pbuf Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
start) Int
len
where
len :: Int
len = Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start
mkBigPS :: Int -> [ByteString] -> IO ByteString
mkBigPS :: Int -> [ByteString] -> IO ByteString
mkBigPS Int
_ [ByteString
ps] = ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
ps
mkBigPS Int
_ [ByteString]
pss = ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! [ByteString] -> ByteString
concat ([ByteString] -> [ByteString]
forall a. [a] -> [a]
P.reverse [ByteString]
pss)
hPut :: Handle -> ByteString -> IO ()
hPut :: Handle -> ByteString -> IO ()
hPut Handle
_ (PS ForeignPtr Word8
_ Int
_ Int
0) = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
hPut Handle
h (PS ForeignPtr Word8
ps Int
s Int
l) = ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
ps ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p-> Handle -> Ptr Any -> Int -> IO ()
forall a. Handle -> Ptr a -> Int -> IO ()
hPutBuf Handle
h (Ptr Word8
p Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s) Int
l
hPutNonBlocking :: Handle -> ByteString -> IO ByteString
hPutNonBlocking :: Handle -> ByteString -> IO ByteString
hPutNonBlocking Handle
h bs :: ByteString
bs@(PS ForeignPtr Word8
ps Int
s Int
l) = do
Int
bytesWritten <- ForeignPtr Word8 -> (Ptr Word8 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
ps ((Ptr Word8 -> IO Int) -> IO Int)
-> (Ptr Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p-> Handle -> Ptr Any -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hPutBufNonBlocking Handle
h (Ptr Word8
p Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s) Int
l
ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! Int -> ByteString -> ByteString
drop Int
bytesWritten ByteString
bs
hPutStr :: Handle -> ByteString -> IO ()
hPutStr :: Handle -> ByteString -> IO ()
hPutStr = Handle -> ByteString -> IO ()
hPut
hPutStrLn :: Handle -> ByteString -> IO ()
hPutStrLn :: Handle -> ByteString -> IO ()
hPutStrLn Handle
h ByteString
ps
| ByteString -> Int
length ByteString
ps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1024 = Handle -> ByteString -> IO ()
hPut Handle
h (ByteString
ps ByteString -> Word8 -> ByteString
`snoc` Word8
0x0a)
| Bool
otherwise = Handle -> ByteString -> IO ()
hPut Handle
h ByteString
ps IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> ByteString -> IO ()
hPut Handle
h (Word8 -> ByteString
singleton (Word8
0x0a))
putStr :: ByteString -> IO ()
putStr :: ByteString -> IO ()
putStr = Handle -> ByteString -> IO ()
hPut Handle
stdout
putStrLn :: ByteString -> IO ()
putStrLn :: ByteString -> IO ()
putStrLn = Handle -> ByteString -> IO ()
hPutStrLn Handle
stdout
{-# DEPRECATED hPutStrLn
"Use Data.ByteString.Char8.hPutStrLn instead. (Functions that rely on ASCII encodings belong in Data.ByteString.Char8)"
#-}
{-# DEPRECATED putStrLn
"Use Data.ByteString.Char8.putStrLn instead. (Functions that rely on ASCII encodings belong in Data.ByteString.Char8)"
#-}
hGet :: Handle -> Int -> IO ByteString
hGet :: Handle -> Int -> IO ByteString
hGet Handle
h Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> (Ptr Word8 -> IO Int) -> IO ByteString
createAndTrim Int
i ((Ptr Word8 -> IO Int) -> IO ByteString)
-> (Ptr Word8 -> IO Int) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Handle -> Ptr Word8 -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
h Ptr Word8
p Int
i
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
empty
| Bool
otherwise = Handle -> String -> Int -> IO ByteString
forall a. Handle -> String -> Int -> IO a
illegalBufferSize Handle
h String
"hGet" Int
i
hGetNonBlocking :: Handle -> Int -> IO ByteString
hGetNonBlocking :: Handle -> Int -> IO ByteString
hGetNonBlocking Handle
h Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> (Ptr Word8 -> IO Int) -> IO ByteString
createAndTrim Int
i ((Ptr Word8 -> IO Int) -> IO ByteString)
-> (Ptr Word8 -> IO Int) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Handle -> Ptr Word8 -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBufNonBlocking Handle
h Ptr Word8
p Int
i
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
empty
| Bool
otherwise = Handle -> String -> Int -> IO ByteString
forall a. Handle -> String -> Int -> IO a
illegalBufferSize Handle
h String
"hGetNonBlocking" Int
i
hGetSome :: Handle -> Int -> IO ByteString
hGetSome :: Handle -> Int -> IO ByteString
hGetSome Handle
hh Int
i
#if MIN_VERSION_base(4,3,0)
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> (Ptr Word8 -> IO Int) -> IO ByteString
createAndTrim Int
i ((Ptr Word8 -> IO Int) -> IO ByteString)
-> (Ptr Word8 -> IO Int) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Handle -> Ptr Word8 -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBufSome Handle
hh Ptr Word8
p Int
i
#else
| i > 0 = let
loop = do
s <- hGetNonBlocking hh i
if not (null s)
then return s
else do eof <- hIsEOF hh
if eof then return s
else hWaitForInput hh (-1) >> loop
in loop
#endif
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
empty
| Bool
otherwise = Handle -> String -> Int -> IO ByteString
forall a. Handle -> String -> Int -> IO a
illegalBufferSize Handle
hh String
"hGetSome" Int
i
illegalBufferSize :: Handle -> String -> Int -> IO a
illegalBufferSize :: Handle -> String -> Int -> IO a
illegalBufferSize Handle
handle String
fn Int
sz =
IOError -> IO a
forall a. IOError -> IO a
ioError (IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError IOErrorType
illegalOperationErrorType String
msg (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
handle) Maybe String
forall a. Maybe a
Nothing)
where
msg :: String
msg = String
fn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": illegal ByteString size " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Int -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
9 Int
sz []
hGetContents :: Handle -> IO ByteString
hGetContents :: Handle -> IO ByteString
hGetContents Handle
hnd = do
ByteString
bs <- Handle -> Int -> Int -> IO ByteString
hGetContentsSizeHint Handle
hnd Int
1024 Int
2048
IO ByteString -> IO () -> IO ByteString
forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
hClose Handle
hnd
if ByteString -> Int
length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
900
then ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString
copy ByteString
bs
else ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
hGetContentsSizeHint :: Handle
-> Int
-> Int
-> IO ByteString
hGetContentsSizeHint :: Handle -> Int -> Int -> IO ByteString
hGetContentsSizeHint Handle
hnd =
[ByteString] -> Int -> Int -> IO ByteString
readChunks []
where
readChunks :: [ByteString] -> Int -> Int -> IO ByteString
readChunks [ByteString]
chunks Int
sz Int
sz' = do
ForeignPtr Word8
fp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
sz
Int
readcount <- ForeignPtr Word8 -> (Ptr Word8 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO Int) -> IO Int)
-> (Ptr Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
buf -> Handle -> Ptr Word8 -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
hnd Ptr Word8
buf Int
sz
let chunk :: ByteString
chunk = ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp Int
0 Int
readcount
if Int
readcount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sz Bool -> Bool -> Bool
&& Int
sz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! [ByteString] -> ByteString
concat ([ByteString] -> [ByteString]
forall a. [a] -> [a]
P.reverse (ByteString
chunk ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
chunks))
else [ByteString] -> Int -> Int -> IO ByteString
readChunks (ByteString
chunk ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
chunks) Int
sz' ((Int
szInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sz') Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` Int
32752)
getContents :: IO ByteString
getContents :: IO ByteString
getContents = Handle -> IO ByteString
hGetContents Handle
stdin
interact :: (ByteString -> ByteString) -> IO ()
interact :: (ByteString -> ByteString) -> IO ()
interact ByteString -> ByteString
transformer = ByteString -> IO ()
putStr (ByteString -> IO ())
-> (ByteString -> ByteString) -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
transformer (ByteString -> IO ()) -> IO ByteString -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO ByteString
getContents
readFile :: FilePath -> IO ByteString
readFile :: String -> IO ByteString
readFile String
f =
String -> IOMode -> (Handle -> IO ByteString) -> IO ByteString
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
f IOMode
ReadMode ((Handle -> IO ByteString) -> IO ByteString)
-> (Handle -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
Integer
filesz <- IO Integer -> (IOError -> IO Integer) -> IO Integer
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (Handle -> IO Integer
hFileSize Handle
h) IOError -> IO Integer
useZeroIfNotRegularFile
let readsz :: Int
readsz = (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
filesz Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
0) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
Handle -> Int -> Int -> IO ByteString
hGetContentsSizeHint Handle
h Int
readsz (Int
readsz Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
255)
where
useZeroIfNotRegularFile :: IOException -> IO Integer
useZeroIfNotRegularFile :: IOError -> IO Integer
useZeroIfNotRegularFile IOError
_ = Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0
modifyFile :: IOMode -> FilePath -> ByteString -> IO ()
modifyFile :: IOMode -> String -> ByteString -> IO ()
modifyFile IOMode
mode String
f ByteString
txt = String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile String
f IOMode
mode (Handle -> ByteString -> IO ()
`hPut` ByteString
txt)
writeFile :: FilePath -> ByteString -> IO ()
writeFile :: String -> ByteString -> IO ()
writeFile = IOMode -> String -> ByteString -> IO ()
modifyFile IOMode
WriteMode
appendFile :: FilePath -> ByteString -> IO ()
appendFile :: String -> ByteString -> IO ()
appendFile = IOMode -> String -> ByteString -> IO ()
modifyFile IOMode
AppendMode
findIndexOrEnd :: (Word8 -> Bool) -> ByteString -> Int
findIndexOrEnd :: (Word8 -> Bool) -> ByteString -> Int
findIndexOrEnd Word8 -> Bool
k (PS ForeignPtr Word8
x Int
s Int
l) =
IO Int -> Int
forall a. IO a -> a
accursedUnutterablePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$
ForeignPtr Word8 -> (Ptr Word8 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO Int) -> IO Int)
-> (Ptr Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
f ->
Ptr Word8 -> Int -> IO Int
go (Ptr Word8
f Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s) Int
0
where
go :: Ptr Word8 -> Int -> IO Int
go !Ptr Word8
ptr !Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l = Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
l
| Bool
otherwise = do Word8
w <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr
if Word8 -> Bool
k Word8
w
then Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
else Ptr Word8 -> Int -> IO Int
go (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
{-# INLINE findIndexOrEnd #-}
errorEmptyList :: String -> a
errorEmptyList :: String -> a
errorEmptyList String
fun = String -> String -> a
forall a. String -> String -> a
moduleError String
fun String
"empty ByteString"
{-# NOINLINE errorEmptyList #-}
moduleError :: String -> String -> a
moduleError :: String -> String -> a
moduleError String
fun String
msg = String -> a
forall a. (?callStack::CallStack) => String -> a
error (String -> String -> String
moduleErrorMsg String
fun String
msg)
{-# NOINLINE moduleError #-}
moduleErrorIO :: String -> String -> IO a
moduleErrorIO :: String -> String -> IO a
moduleErrorIO String
fun String
msg = IOError -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO a) -> (String -> IOError) -> String -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOError
userError (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ String -> String -> String
moduleErrorMsg String
fun String
msg
{-# NOINLINE moduleErrorIO #-}
moduleErrorMsg :: String -> String -> String
moduleErrorMsg :: String -> String -> String
moduleErrorMsg String
fun String
msg = String
"Data.ByteString." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fun String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
':'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
msg
findFromEndUntil :: (Word8 -> Bool) -> ByteString -> Int
findFromEndUntil :: (Word8 -> Bool) -> ByteString -> Int
findFromEndUntil Word8 -> Bool
f ps :: ByteString
ps@(PS ForeignPtr Word8
x Int
s Int
l)
| ByteString -> Bool
null ByteString
ps = Int
0
| Word8 -> Bool
f (ByteString -> Word8
unsafeLast ByteString
ps) = Int
l
| Bool
otherwise = (Word8 -> Bool) -> ByteString -> Int
findFromEndUntil Word8 -> Bool
f (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
x Int
s (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))