{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
module Data.ByteString (
ByteString,
StrictByteString,
empty,
singleton,
pack,
unpack,
fromStrict,
toStrict,
fromFilePath,
toFilePath,
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,
takeEnd,
drop,
dropEnd,
splitAt,
takeWhile,
takeWhileEnd,
dropWhile,
dropWhileEnd,
span,
spanEnd,
break,
breakEnd,
group,
groupBy,
inits,
tails,
initsNE,
tailsNE,
stripPrefix,
stripSuffix,
split,
splitWith,
isPrefixOf,
isSuffixOf,
isInfixOf,
isValidUtf8,
breakSubstring,
elem,
notElem,
find,
filter,
partition,
index,
indexMaybe,
(!?),
elemIndex,
elemIndices,
elemIndexEnd,
findIndex,
findIndices,
findIndexEnd,
count,
zip,
zipWith,
packZipWith,
unzip,
sort,
copy,
packCString,
packCStringLen,
useAsCString,
useAsCStringLen,
getLine,
getContents,
putStr,
interact,
readFile,
writeFile,
appendFile,
hGetLine,
hGetContents,
hGet,
hGetSome,
hGetNonBlocking,
hPut,
hPutNonBlocking,
hPutStr,
) where
import qualified Prelude as P
import Prelude hiding (reverse,head,tail,last,init,Foldable(..)
,map,lines,unlines
,concat,any,take,drop,splitAt,takeWhile
,dropWhile,span,break,filter
,all,concatMap
,scanl,scanl1,scanr,scanr1
,readFile,writeFile,appendFile,replicate
,getContents,getLine,putStr,putStrLn,interact
,zip,zipWith,unzip,notElem
)
import Data.Bits (finiteBitSize, shiftL, (.|.), (.&.))
import Data.ByteString.Internal.Type
import Data.ByteString.Lazy.Internal (fromStrict, toStrict)
import Data.ByteString.Unsafe
import qualified Data.List as List
import qualified Data.List.NonEmpty as NE
import Data.List.NonEmpty (NonEmpty(..))
import Data.Word (Word8)
import Control.Exception (IOException, catch, finally, assert, throwIO)
import Control.Monad (when)
import Foreign.C.String (CString, CStringLen)
import Foreign.C.Types (CSize (CSize), CInt (CInt))
import Foreign.ForeignPtr (ForeignPtr, touchForeignPtr)
import Foreign.ForeignPtr.Unsafe(unsafeForeignPtrToPtr)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Marshal.Array (allocaArray)
import Foreign.Marshal.Utils
import Foreign.Ptr
import Foreign.Storable (Storable(..))
import System.IO (stdin,stdout,hClose,hFileSize
,hGetBuf,hPutBuf,hGetBufNonBlocking
,hPutBufNonBlocking,withBinaryFile
,IOMode(..),hGetBufSome)
import System.IO.Error (mkIOError, illegalOperationErrorType)
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.Encoding (getFileSystemEncoding)
import GHC.Foreign (newCStringLen, peekCStringLen)
import GHC.Stack.Types (HasCallStack)
import Data.Char (ord)
import GHC.Base (build)
import GHC.Word hiding (Word8)
singleton :: Word8 -> ByteString
singleton :: Word8 -> ByteString
singleton Word8
c = Int -> ByteString -> ByteString
unsafeTake Int
1 forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
unsafeDrop (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c) ByteString
allBytes
{-# INLINE singleton #-}
allBytes :: ByteString
allBytes :: ByteString
allBytes = Int -> Addr# -> ByteString
unsafePackLenLiteral Int
0x100
Addr#
"\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8a\x8b\x8c\x8d\x8e\x8f\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9a\x9b\x9c\x9d\x9e\x9f\xa0\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xab\xac\xad\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\xba\xbb\xbc\xbd\xbe\xbf\xc0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\xcc\xcd\xce\xcf\xd0\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xda\xdb\xdc\xdd\xde\xdf\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\xfc\xfd\xfe\xff"#
pack :: [Word8] -> ByteString
pack :: [Word8] -> ByteString
pack = [Word8] -> ByteString
packBytes
unpack :: ByteString -> [Word8]
unpack :: ByteString -> [Word8]
unpack ByteString
bs = forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (forall a. ByteString -> (Word8 -> a -> a) -> a -> a
unpackFoldr ByteString
bs)
{-# INLINE unpack #-}
unpackFoldr :: ByteString -> (Word8 -> a -> a) -> a -> a
unpackFoldr :: forall a. ByteString -> (Word8 -> a -> a) -> a -> a
unpackFoldr ByteString
bs Word8 -> a -> a
k a
z = 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
#-}
fromFilePath :: FilePath -> IO ByteString
fromFilePath :: FilePath -> IO ByteString
fromFilePath FilePath
path = do
TextEncoding
enc <- IO TextEncoding
getFileSystemEncoding
TextEncoding -> FilePath -> IO CStringLen
newCStringLen TextEncoding
enc FilePath
path forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CStringLen -> IO ByteString
unsafePackMallocCStringLen
toFilePath :: ByteString -> IO FilePath
toFilePath :: ByteString -> IO FilePath
toFilePath ByteString
path = do
TextEncoding
enc <- IO TextEncoding
getFileSystemEncoding
forall a. ByteString -> (CStringLen -> IO a) -> IO a
useAsCStringLen ByteString
path (TextEncoding -> CStringLen -> IO FilePath
peekCStringLen TextEncoding
enc)
null :: ByteString -> Bool
null :: ByteString -> Bool
null (BS ForeignPtr Word8
_ Int
l) = forall a. HasCallStack => Bool -> a -> a
assert (Int
l forall a. Ord a => a -> a -> Bool
>= Int
0) forall a b. (a -> b) -> a -> b
$ Int
l forall a. Ord a => a -> a -> Bool
<= Int
0
{-# INLINE null #-}
length :: ByteString -> Int
length :: ByteString -> Int
length (BS ForeignPtr Word8
_ Int
l) = forall a. HasCallStack => Bool -> a -> a
assert (Int
l 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 (BS ForeignPtr Word8
x Int
l) = Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp (Int
lforall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
p -> do
forall a. Storable a => ForeignPtr a -> a -> IO ()
pokeFp ForeignPtr Word8
p Word8
c
ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp (ForeignPtr Word8
p forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
1) ForeignPtr Word8
x Int
l
{-# INLINE cons #-}
snoc :: ByteString -> Word8 -> ByteString
snoc :: ByteString -> Word8 -> ByteString
snoc (BS ForeignPtr Word8
x Int
l) Word8
c = Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp (Int
lforall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
p -> do
ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp ForeignPtr Word8
p ForeignPtr Word8
x Int
l
forall a. Storable a => ForeignPtr a -> a -> IO ()
pokeFp (ForeignPtr Word8
p forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
l) Word8
c
{-# INLINE snoc #-}
head :: HasCallStack => ByteString -> Word8
head :: HasCallStack => ByteString -> Word8
head (BS ForeignPtr Word8
x Int
l)
| Int
l forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. HasCallStack => FilePath -> a
errorEmptyList FilePath
"head"
| Bool
otherwise = forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p
{-# INLINE head #-}
tail :: HasCallStack => ByteString -> ByteString
tail :: HasCallStack => ByteString -> ByteString
tail (BS ForeignPtr Word8
p Int
l)
| Int
l forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. HasCallStack => FilePath -> a
errorEmptyList FilePath
"tail"
| Bool
otherwise = ForeignPtr Word8 -> Int -> ByteString
BS (forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
p Int
1) (Int
lforall a. Num a => a -> a -> a
-Int
1)
{-# INLINE tail #-}
uncons :: ByteString -> Maybe (Word8, ByteString)
uncons :: ByteString -> Maybe (Word8, ByteString)
uncons (BS ForeignPtr Word8
x Int
l)
| Int
l forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just (forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p,
ForeignPtr Word8 -> Int -> ByteString
BS (forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
x Int
1) (Int
lforall a. Num a => a -> a -> a
-Int
1))
{-# INLINE uncons #-}
last :: HasCallStack => ByteString -> Word8
last :: HasCallStack => ByteString -> Word8
last ps :: ByteString
ps@(BS ForeignPtr Word8
x Int
l)
| ByteString -> Bool
null ByteString
ps = forall a. HasCallStack => FilePath -> a
errorEmptyList FilePath
"last"
| Bool
otherwise = forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
p (Int
lforall a. Num a => a -> a -> a
-Int
1)
{-# INLINE last #-}
init :: HasCallStack => ByteString -> ByteString
init :: HasCallStack => ByteString -> ByteString
init ps :: ByteString
ps@(BS ForeignPtr Word8
p Int
l)
| ByteString -> Bool
null ByteString
ps = forall a. HasCallStack => FilePath -> a
errorEmptyList FilePath
"init"
| Bool
otherwise = ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
p (Int
lforall a. Num a => a -> a -> a
-Int
1)
{-# INLINE init #-}
unsnoc :: ByteString -> Maybe (ByteString, Word8)
unsnoc :: ByteString -> Maybe (ByteString, Word8)
unsnoc (BS ForeignPtr Word8
x Int
l)
| Int
l forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just (ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
x (Int
lforall a. Num a => a -> a -> a
-Int
1),
forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
p (Int
lforall a. Num a => a -> a -> a
-Int
1))
{-# INLINE unsnoc #-}
append :: ByteString -> ByteString -> ByteString
append :: ByteString -> ByteString -> ByteString
append = forall a. Monoid a => a -> a -> a
mappend
{-# INLINE append #-}
map :: (Word8 -> Word8) -> ByteString -> ByteString
map :: (Word8 -> Word8) -> ByteString -> ByteString
map Word8 -> Word8
f (BS ForeignPtr Word8
srcPtr Int
len) = Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp Int
len forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
dstPtr -> forall {b}. ForeignPtr Word8 -> ForeignPtr b -> IO ()
m ForeignPtr Word8
srcPtr ForeignPtr Word8
dstPtr
where
m :: ForeignPtr Word8 -> ForeignPtr b -> IO ()
m !ForeignPtr Word8
p1 !ForeignPtr b
p2 = Int -> IO ()
map_ Int
0
where
map_ :: Int -> IO ()
map_ :: Int -> IO ()
map_ !Int
n
| Int
n forall a. Ord a => a -> a -> Bool
>= Int
len = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
Word8
x <- forall a. Storable a => ForeignPtr a -> Int -> IO a
peekFpByteOff ForeignPtr Word8
p1 Int
n
forall a b. Storable a => ForeignPtr b -> Int -> a -> IO ()
pokeFpByteOff ForeignPtr b
p2 Int
n (Word8 -> Word8
f Word8
x)
Int -> IO ()
map_ (Int
nforall a. Num a => a -> a -> a
+Int
1)
{-# INLINE map #-}
reverse :: ByteString -> ByteString
reverse :: ByteString -> ByteString
reverse (BS ForeignPtr Word8
x Int
l) = Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp Int
l forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
fp ->
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x forall a b. (a -> b) -> a -> b
$ \Ptr Word8
f ->
Ptr Word8 -> Ptr Word8 -> CSize -> IO ()
c_reverse Ptr Word8
p Ptr Word8
f (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@(BS ForeignPtr Word8
x Int
l)
| ByteString -> Int
length ByteString
ps forall a. Ord a => a -> a -> Bool
< Int
2 = ByteString
ps
| Bool
otherwise = Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp (Int
2forall a. Num a => a -> a -> a
*Int
lforall a. Num a => a -> a -> a
-Int
1) forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
fp ->
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x forall a b. (a -> b) -> a -> b
$ \Ptr Word8
f ->
Ptr Word8 -> Ptr Word8 -> CSize -> Word8 -> IO ()
c_intersperse Ptr Word8
p Ptr Word8
f (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) Word8
c
transpose :: [ByteString] -> [ByteString]
transpose :: [ByteString] -> [ByteString]
transpose = forall a b. (a -> b) -> [a] -> [b]
P.map [Word8] -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[a]] -> [[a]]
List.transpose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
P.map ByteString -> [Word8]
unpack
foldl :: (a -> Word8 -> a) -> a -> ByteString -> a
foldl :: forall a. (a -> Word8 -> a) -> a -> ByteString -> a
foldl a -> Word8 -> a
f a
z = \(BS ForeignPtr Word8
fp Int
len) ->
let
end :: Ptr b
end = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fp forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)
go :: Ptr Word8 -> a
go !Ptr Word8
p | Ptr Word8
p forall a. Eq a => a -> a -> Bool
== forall {b}. Ptr b
end = a
z
| Bool
otherwise = let !x :: Word8
x = forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ do
Word8
x' <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Word8
fp
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
x'
in a -> Word8 -> a
f (Ptr Word8 -> a
go (Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1))) Word8
x
in
Ptr Word8 -> a
go (forall {b}. Ptr b
end forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len)
{-# INLINE foldl #-}
foldl' :: (a -> Word8 -> a) -> a -> ByteString -> a
foldl' :: forall a. (a -> Word8 -> a) -> a -> ByteString -> a
foldl' a -> Word8 -> a
f a
v = \(BS ForeignPtr Word8
fp Int
len) ->
let
g :: ForeignPtr Word8 -> IO a
g ForeignPtr Word8
ptr = a -> ForeignPtr Word8 -> IO a
go a
v ForeignPtr Word8
ptr
where
end :: ForeignPtr b
end = ForeignPtr Word8
ptr forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
len
go :: a -> ForeignPtr Word8 -> IO a
go !a
z !ForeignPtr Word8
p | ForeignPtr Word8
p forall a. Eq a => a -> a -> Bool
== forall {b}. ForeignPtr b
end = forall (m :: * -> *) a. Monad m => a -> m a
return a
z
| Bool
otherwise = do Word8
x <- forall a. Storable a => ForeignPtr a -> IO a
peekFp ForeignPtr Word8
p
a -> ForeignPtr Word8 -> IO a
go (a -> Word8 -> a
f a
z Word8
x) (ForeignPtr Word8
p forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
1)
in
forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> IO a
g ForeignPtr Word8
fp
{-# INLINE foldl' #-}
foldr :: (Word8 -> a -> a) -> a -> ByteString -> a
foldr :: forall a. (Word8 -> a -> a) -> a -> ByteString -> a
foldr Word8 -> a -> a
k a
z = \(BS ForeignPtr Word8
fp Int
len) ->
let
ptr :: Ptr Word8
ptr = forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fp
end :: Ptr b
end = Ptr Word8
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
go :: Ptr Word8 -> a
go !Ptr Word8
p | Ptr Word8
p forall a. Eq a => a -> a -> Bool
== forall {b}. Ptr b
end = a
z
| Bool
otherwise = let !x :: Word8
x = forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ do
Word8
x' <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Word8
fp
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
x'
in Word8 -> a -> a
k Word8
x (Ptr Word8 -> a
go (Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1))
in
Ptr Word8 -> a
go Ptr Word8
ptr
{-# INLINE foldr #-}
foldr' :: (Word8 -> a -> a) -> a -> ByteString -> a
foldr' :: forall a. (Word8 -> a -> a) -> a -> ByteString -> a
foldr' Word8 -> a -> a
k a
v = \(BS ForeignPtr Word8
fp Int
len) ->
let
g :: ForeignPtr a -> IO a
g ForeignPtr a
ptr = a -> ForeignPtr Word8 -> IO a
go a
v (forall {b}. ForeignPtr b
end forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
len)
where
end :: ForeignPtr b
end = ForeignPtr a
ptr forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` (-Int
1)
go :: a -> ForeignPtr Word8 -> IO a
go !a
z !ForeignPtr Word8
p | ForeignPtr Word8
p forall a. Eq a => a -> a -> Bool
== forall {b}. ForeignPtr b
end = forall (m :: * -> *) a. Monad m => a -> m a
return a
z
| Bool
otherwise = do Word8
x <- forall a. Storable a => ForeignPtr a -> IO a
peekFp ForeignPtr Word8
p
a -> ForeignPtr Word8 -> IO a
go (Word8 -> a -> a
k Word8
x a
z) (ForeignPtr Word8
p forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` (-Int
1))
in
forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ forall {a}. ForeignPtr a -> IO a
g ForeignPtr Word8
fp
{-# INLINE foldr' #-}
foldl1 :: HasCallStack => (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldl1 :: HasCallStack => (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldl1 Word8 -> Word8 -> Word8
f ByteString
ps = case ByteString -> Maybe (Word8, ByteString)
uncons ByteString
ps of
Maybe (Word8, ByteString)
Nothing -> forall a. HasCallStack => FilePath -> a
errorEmptyList FilePath
"foldl1"
Just (Word8
h, ByteString
t) -> forall a. (a -> Word8 -> a) -> a -> ByteString -> a
foldl Word8 -> Word8 -> Word8
f Word8
h ByteString
t
{-# INLINE foldl1 #-}
foldl1' :: HasCallStack => (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldl1' :: HasCallStack => (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldl1' Word8 -> Word8 -> Word8
f ByteString
ps = case ByteString -> Maybe (Word8, ByteString)
uncons ByteString
ps of
Maybe (Word8, ByteString)
Nothing -> forall a. HasCallStack => FilePath -> a
errorEmptyList FilePath
"foldl1'"
Just (Word8
h, ByteString
t) -> forall a. (a -> Word8 -> a) -> a -> ByteString -> a
foldl' Word8 -> Word8 -> Word8
f Word8
h ByteString
t
{-# INLINE foldl1' #-}
foldr1 :: HasCallStack => (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldr1 :: HasCallStack => (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldr1 Word8 -> Word8 -> Word8
f ByteString
ps = case ByteString -> Maybe (ByteString, Word8)
unsnoc ByteString
ps of
Maybe (ByteString, Word8)
Nothing -> forall a. HasCallStack => FilePath -> a
errorEmptyList FilePath
"foldr1"
Just (ByteString
b, Word8
c) -> forall a. (Word8 -> a -> a) -> a -> ByteString -> a
foldr Word8 -> Word8 -> Word8
f Word8
c ByteString
b
{-# INLINE foldr1 #-}
foldr1' :: HasCallStack => (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldr1' :: HasCallStack => (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldr1' Word8 -> Word8 -> Word8
f ByteString
ps = case ByteString -> Maybe (ByteString, Word8)
unsnoc ByteString
ps of
Maybe (ByteString, Word8)
Nothing -> forall a. HasCallStack => FilePath -> a
errorEmptyList FilePath
"foldr1'"
Just (ByteString
b, Word8
c) -> forall a. (Word8 -> a -> a) -> a -> ByteString -> a
foldr' Word8 -> Word8 -> Word8
f Word8
c ByteString
b
{-# INLINE foldr1' #-}
concat :: [ByteString] -> ByteString
concat :: [ByteString] -> ByteString
concat = forall a. Monoid a => [a] -> a
mconcat
concatMap :: (Word8 -> ByteString) -> ByteString -> ByteString
concatMap :: (Word8 -> ByteString) -> ByteString -> ByteString
concatMap Word8 -> ByteString
f = [ByteString] -> ByteString
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Word8 -> a -> a) -> a -> ByteString -> a
foldr ((:) 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
_ (BS ForeignPtr Word8
_ Int
0) = Bool
False
any Word8 -> Bool
f (BS ForeignPtr Word8
x Int
len) = forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> IO Bool
g ForeignPtr Word8
x
where
g :: ForeignPtr Word8 -> IO Bool
g ForeignPtr Word8
ptr = ForeignPtr Word8 -> IO Bool
go ForeignPtr Word8
ptr
where
end :: ForeignPtr b
end = ForeignPtr Word8
ptr forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
len
go :: ForeignPtr Word8 -> IO Bool
go !ForeignPtr Word8
p | ForeignPtr Word8
p forall a. Eq a => a -> a -> Bool
== forall {b}. ForeignPtr b
end = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
| Bool
otherwise = do Word8
c <- forall a. Storable a => ForeignPtr a -> IO a
peekFp ForeignPtr Word8
p
if Word8 -> Bool
f Word8
c then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else ForeignPtr Word8 -> IO Bool
go (ForeignPtr Word8
p forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
1)
{-# INLINE [1] any #-}
{-# RULES
"ByteString specialise any (x ==)" forall x.
any (x `eqWord8`) = anyByte x
"ByteString specialise any (== x)" forall x.
any (`eqWord8` x) = anyByte x
#-}
anyByte :: Word8 -> ByteString -> Bool
anyByte :: Word8 -> ByteString -> Bool
anyByte Word8
c (BS ForeignPtr Word8
x Int
l) = forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
Ptr Word8
q <- Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
memchr Ptr Word8
p Word8
c (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Ptr Word8
q forall a. Eq a => a -> a -> Bool
/= forall {b}. Ptr b
nullPtr
{-# INLINE anyByte #-}
all :: (Word8 -> Bool) -> ByteString -> Bool
all :: (Word8 -> Bool) -> ByteString -> Bool
all Word8 -> Bool
_ (BS ForeignPtr Word8
_ Int
0) = Bool
True
all Word8 -> Bool
f (BS ForeignPtr Word8
x Int
len) = forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> IO Bool
g ForeignPtr Word8
x
where
g :: ForeignPtr Word8 -> IO Bool
g ForeignPtr Word8
ptr = ForeignPtr Word8 -> IO Bool
go ForeignPtr Word8
ptr
where
end :: ForeignPtr b
end = ForeignPtr Word8
ptr forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
len
go :: ForeignPtr Word8 -> IO Bool
go !ForeignPtr Word8
p | ForeignPtr Word8
p forall a. Eq a => a -> a -> Bool
== forall {b}. ForeignPtr b
end = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
| Bool
otherwise = do Word8
c <- forall a. Storable a => ForeignPtr a -> IO a
peekFp ForeignPtr Word8
p
if Word8 -> Bool
f Word8
c
then ForeignPtr Word8 -> IO Bool
go (ForeignPtr Word8
p forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
1)
else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
{-# INLINE [1] all #-}
{-# RULES
"ByteString specialise all (x /=)" forall x.
all (x `neWord8`) = not . anyByte x
"ByteString specialise all (/= x)" forall x.
all (`neWord8` x) = not . anyByte x
#-}
maximum :: HasCallStack => ByteString -> Word8
maximum :: HasCallStack => ByteString -> Word8
maximum xs :: ByteString
xs@(BS ForeignPtr Word8
x Int
l)
| ByteString -> Bool
null ByteString
xs = forall a. HasCallStack => FilePath -> a
errorEmptyList FilePath
"maximum"
| Bool
otherwise = forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
Ptr Word8 -> CSize -> IO Word8
c_maximum Ptr Word8
p (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
{-# INLINE maximum #-}
minimum :: HasCallStack => ByteString -> Word8
minimum :: HasCallStack => ByteString -> Word8
minimum xs :: ByteString
xs@(BS ForeignPtr Word8
x Int
l)
| ByteString -> Bool
null ByteString
xs = forall a. HasCallStack => FilePath -> a
errorEmptyList FilePath
"minimum"
| Bool
otherwise = forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
Ptr Word8 -> CSize -> IO Word8
c_minimum Ptr Word8
p (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
{-# INLINE minimum #-}
mapAccumL :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)
mapAccumL :: forall acc.
(acc -> Word8 -> (acc, Word8))
-> acc -> ByteString -> (acc, ByteString)
mapAccumL acc -> Word8 -> (acc, Word8)
f acc
acc = \(BS ForeignPtr Word8
a Int
len) -> forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ do
ForeignPtr Word8
gp <- forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
len
let
go :: ForeignPtr Word8 -> ForeignPtr b -> IO acc
go ForeignPtr Word8
src ForeignPtr b
dst = acc -> Int -> IO acc
mapAccumL_ acc
acc Int
0
where
mapAccumL_ :: acc -> Int -> IO acc
mapAccumL_ !acc
s !Int
n
| Int
n forall a. Ord a => a -> a -> Bool
>= Int
len = forall (m :: * -> *) a. Monad m => a -> m a
return acc
s
| Bool
otherwise = do
Word8
x <- forall a. Storable a => ForeignPtr a -> Int -> IO a
peekFpByteOff ForeignPtr Word8
src Int
n
let (acc
s', Word8
y) = acc -> Word8 -> (acc, Word8)
f acc
s Word8
x
forall a b. Storable a => ForeignPtr b -> Int -> a -> IO ()
pokeFpByteOff ForeignPtr b
dst Int
n Word8
y
acc -> Int -> IO acc
mapAccumL_ acc
s' (Int
nforall a. Num a => a -> a -> a
+Int
1)
acc
acc' <- forall {b}. ForeignPtr Word8 -> ForeignPtr b -> IO acc
go ForeignPtr Word8
a ForeignPtr Word8
gp
forall (m :: * -> *) a. Monad m => a -> m a
return (acc
acc', ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
gp Int
len)
{-# INLINE mapAccumL #-}
mapAccumR :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)
mapAccumR :: forall acc.
(acc -> Word8 -> (acc, Word8))
-> acc -> ByteString -> (acc, ByteString)
mapAccumR acc -> Word8 -> (acc, Word8)
f acc
acc = \(BS ForeignPtr Word8
a Int
len) -> forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ do
ForeignPtr Word8
gp <- forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
len
let
go :: ForeignPtr Word8 -> ForeignPtr b -> IO acc
go ForeignPtr Word8
src ForeignPtr b
dst = acc -> Int -> IO acc
mapAccumR_ acc
acc (Int
lenforall a. Num a => a -> a -> a
-Int
1)
where
mapAccumR_ :: acc -> Int -> IO acc
mapAccumR_ !acc
s (-1) = forall (m :: * -> *) a. Monad m => a -> m a
return acc
s
mapAccumR_ !acc
s !Int
n = do
Word8
x <- forall a. Storable a => ForeignPtr a -> Int -> IO a
peekFpByteOff ForeignPtr Word8
src Int
n
let (acc
s', Word8
y) = acc -> Word8 -> (acc, Word8)
f acc
s Word8
x
forall a b. Storable a => ForeignPtr b -> Int -> a -> IO ()
pokeFpByteOff ForeignPtr b
dst Int
n Word8
y
acc -> Int -> IO acc
mapAccumR_ acc
s' (Int
nforall a. Num a => a -> a -> a
-Int
1)
acc
acc' <- forall {b}. ForeignPtr Word8 -> ForeignPtr b -> IO acc
go ForeignPtr Word8
a ForeignPtr Word8
gp
forall (m :: * -> *) a. Monad m => a -> m a
return (acc
acc', ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
gp Int
len)
{-# INLINE mapAccumR #-}
scanl
:: (Word8 -> Word8 -> Word8)
-> Word8
-> ByteString
-> ByteString
scanl :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
scanl Word8 -> Word8 -> Word8
f Word8
v = \(BS ForeignPtr Word8
a Int
len) -> Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp (Int
lenforall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
q -> do
forall a. Storable a => ForeignPtr a -> a -> IO ()
pokeFp ForeignPtr Word8
q Word8
v
let
go :: ForeignPtr Word8 -> ForeignPtr b -> IO ()
go ForeignPtr Word8
src ForeignPtr b
dst = Word8 -> Int -> IO ()
scanl_ Word8
v Int
0
where
scanl_ :: Word8 -> Int -> IO ()
scanl_ !Word8
z !Int
n
| Int
n forall a. Ord a => a -> a -> Bool
>= Int
len = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
Word8
x <- forall a. Storable a => ForeignPtr a -> Int -> IO a
peekFpByteOff ForeignPtr Word8
src Int
n
let z' :: Word8
z' = Word8 -> Word8 -> Word8
f Word8
z Word8
x
forall a b. Storable a => ForeignPtr b -> Int -> a -> IO ()
pokeFpByteOff ForeignPtr b
dst Int
n Word8
z'
Word8 -> Int -> IO ()
scanl_ Word8
z' (Int
nforall a. Num a => a -> a -> a
+Int
1)
forall {b}. ForeignPtr Word8 -> ForeignPtr b -> IO ()
go ForeignPtr Word8
a (ForeignPtr Word8
q forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
1)
{-# INLINE scanl #-}
scanl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
scanl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
scanl1 Word8 -> Word8 -> Word8
f ByteString
ps = case ByteString -> Maybe (Word8, ByteString)
uncons ByteString
ps of
Maybe (Word8, ByteString)
Nothing -> ByteString
empty
Just (Word8
h, ByteString
t) -> (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
scanl Word8 -> Word8 -> Word8
f Word8
h ByteString
t
{-# INLINE scanl1 #-}
scanr
:: (Word8 -> Word8 -> Word8)
-> Word8
-> ByteString
-> ByteString
scanr :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
scanr Word8 -> Word8 -> Word8
f Word8
v = \(BS ForeignPtr Word8
a Int
len) -> Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp (Int
lenforall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
b -> do
forall a b. Storable a => ForeignPtr b -> Int -> a -> IO ()
pokeFpByteOff ForeignPtr Word8
b Int
len Word8
v
let
go :: ForeignPtr Word8 -> ForeignPtr b -> IO ()
go ForeignPtr Word8
p ForeignPtr b
q = Word8 -> Int -> IO ()
scanr_ Word8
v (Int
lenforall a. Num a => a -> a -> a
-Int
1)
where
scanr_ :: Word8 -> Int -> IO ()
scanr_ !Word8
z !Int
n
| Int
n forall a. Ord a => a -> a -> Bool
< Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
Word8
x <- forall a. Storable a => ForeignPtr a -> Int -> IO a
peekFpByteOff ForeignPtr Word8
p Int
n
let z' :: Word8
z' = Word8 -> Word8 -> Word8
f Word8
x Word8
z
forall a b. Storable a => ForeignPtr b -> Int -> a -> IO ()
pokeFpByteOff ForeignPtr b
q Int
n Word8
z'
Word8 -> Int -> IO ()
scanr_ Word8
z' (Int
nforall a. Num a => a -> a -> a
-Int
1)
forall {b}. ForeignPtr Word8 -> ForeignPtr b -> IO ()
go ForeignPtr Word8
a ForeignPtr Word8
b
{-# INLINE scanr #-}
scanr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
scanr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
scanr1 Word8 -> Word8 -> Word8
f ByteString
ps = case ByteString -> Maybe (ByteString, Word8)
unsnoc ByteString
ps of
Maybe (ByteString, Word8)
Nothing -> ByteString
empty
Just (ByteString
b, Word8
c) -> (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
scanr Word8 -> Word8 -> Word8
f Word8
c ByteString
b
{-# INLINE scanr1 #-}
replicate :: Int -> Word8 -> ByteString
replicate :: Int -> Word8 -> ByteString
replicate Int
w Word8
c
| Int
w forall a. Ord a => a -> a -> Bool
<= Int
0 = ByteString
empty
| Bool
otherwise = Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp Int
w forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
fptr ->
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fptr forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
forall a. Ptr a -> Word8 -> Int -> IO ()
fillBytes Ptr Word8
ptr Word8
c Int
w
{-# INLINE replicate #-}
unfoldr :: (a -> Maybe (Word8, a)) -> a -> ByteString
unfoldr :: forall a. (a -> Maybe (Word8, a)) -> a -> ByteString
unfoldr a -> Maybe (Word8, a)
f = [ByteString] -> ByteString
concat 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 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
s, Just a
x') -> ByteString
s forall a. a -> [a] -> [a]
: Int -> Int -> a -> [ByteString]
unfoldChunk Int
n' (Int
nforall a. Num a => a -> a -> a
+Int
n') a
x'
{-# INLINE unfoldr #-}
unfoldrN :: Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
unfoldrN :: forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
unfoldrN Int
i a -> Maybe (Word8, a)
f a
x0
| Int
i forall a. Ord a => a -> a -> Bool
< Int
0 = (ByteString
empty, forall a. a -> Maybe a
Just a
x0)
| Bool
otherwise = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ forall a.
Int -> (ForeignPtr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)
createFpAndTrim' Int
i forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
p -> forall {a} {b}.
Num a =>
ForeignPtr b -> a -> Int -> IO (a, Int, Maybe a)
go ForeignPtr Word8
p a
x0 Int
0
where
go :: ForeignPtr b -> a -> Int -> IO (a, Int, Maybe a)
go !ForeignPtr b
p !a
x !Int
n = forall {a}. Num a => a -> Int -> IO (a, Int, Maybe a)
go' a
x Int
n
where
go' :: a -> Int -> IO (a, Int, Maybe a)
go' !a
x' !Int
n'
| Int
n' forall a. Eq a => a -> a -> Bool
== Int
i = forall (m :: * -> *) a. Monad m => a -> m a
return (a
0, Int
n', forall a. a -> Maybe a
Just a
x')
| Bool
otherwise = case a -> Maybe (Word8, a)
f a
x' of
Maybe (Word8, a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (a
0, Int
n', forall a. Maybe a
Nothing)
Just (Word8
w,a
x'') -> do forall a b. Storable a => ForeignPtr b -> Int -> a -> IO ()
pokeFpByteOff ForeignPtr b
p Int
n' Word8
w
a -> Int -> IO (a, Int, Maybe a)
go' a
x'' (Int
n'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@(BS ForeignPtr Word8
x Int
l)
| Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = ByteString
empty
| Int
n forall a. Ord a => a -> a -> Bool
>= Int
l = ByteString
ps
| Bool
otherwise = ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
x Int
n
{-# INLINE take #-}
takeEnd :: Int -> ByteString -> ByteString
takeEnd :: Int -> ByteString -> ByteString
takeEnd Int
n ps :: ByteString
ps@(BS ForeignPtr Word8
x Int
len)
| Int
n forall a. Ord a => a -> a -> Bool
>= Int
len = ByteString
ps
| Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = ByteString
empty
| Bool
otherwise = ForeignPtr Word8 -> Int -> ByteString
BS (forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
x (Int
len forall a. Num a => a -> a -> a
- Int
n)) Int
n
{-# INLINE takeEnd #-}
drop :: Int -> ByteString -> ByteString
drop :: Int -> ByteString -> ByteString
drop Int
n ps :: ByteString
ps@(BS ForeignPtr Word8
x Int
l)
| Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = ByteString
ps
| Int
n forall a. Ord a => a -> a -> Bool
>= Int
l = ByteString
empty
| Bool
otherwise = ForeignPtr Word8 -> Int -> ByteString
BS (forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
x Int
n) (Int
lforall a. Num a => a -> a -> a
-Int
n)
{-# INLINE drop #-}
dropEnd :: Int -> ByteString -> ByteString
dropEnd :: Int -> ByteString -> ByteString
dropEnd Int
n ps :: ByteString
ps@(BS ForeignPtr Word8
x Int
len)
| Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = ByteString
ps
| Int
n forall a. Ord a => a -> a -> Bool
>= Int
len = ByteString
empty
| Bool
otherwise = ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
x (Int
len forall a. Num a => a -> a -> a
- Int
n)
{-# INLINE dropEnd #-}
splitAt :: Int -> ByteString -> (ByteString, ByteString)
splitAt :: Int -> ByteString -> (ByteString, ByteString)
splitAt Int
n ps :: ByteString
ps@(BS ForeignPtr Word8
x Int
l)
| Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = (ByteString
empty, ByteString
ps)
| Int
n forall a. Ord a => a -> a -> Bool
>= Int
l = (ByteString
ps, ByteString
empty)
| Bool
otherwise = (ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
x Int
n, ForeignPtr Word8 -> Int -> ByteString
BS (forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
x Int
n) (Int
lforall 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
findIndexOrLength (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Bool
f) ByteString
ps) ByteString
ps
{-# INLINE [1] takeWhile #-}
{-# RULES
"ByteString specialise takeWhile (x /=)" forall x.
takeWhile (x `neWord8`) = fst . breakByte x
"ByteString specialise takeWhile (/= x)" forall x.
takeWhile (`neWord8` x) = fst . breakByte x
"ByteString specialise takeWhile (x ==)" forall x.
takeWhile (x `eqWord8`) = fst . spanByte x
"ByteString specialise takeWhile (== x)" forall x.
takeWhile (`eqWord8` x) = fst . spanByte x
#-}
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 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
findIndexOrLength (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Bool
f) ByteString
ps) ByteString
ps
{-# INLINE [1] dropWhile #-}
{-# RULES
"ByteString specialise dropWhile (x /=)" forall x.
dropWhile (x `neWord8`) = snd . breakByte x
"ByteString specialise dropWhile (/= x)" forall x.
dropWhile (`neWord8` x) = snd . breakByte x
"ByteString specialise dropWhile (x ==)" forall x.
dropWhile (x `eqWord8`) = snd . spanByte x
"ByteString specialise dropWhile (== x)" forall x.
dropWhile (`eqWord8` x) = snd . spanByte x
#-}
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 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
findIndexOrLength 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 #-}
{-# RULES
"ByteString specialise break (x ==)" forall x.
break (x `eqWord8`) = breakByte x
"ByteString specialise break (== x)" forall x.
break (`eqWord8` x) = breakByte x
#-}
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 #-}
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 = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
break (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Bool
p)
{-# INLINE [1] span #-}
spanByte :: Word8 -> ByteString -> (ByteString, ByteString)
spanByte :: Word8 -> ByteString -> (ByteString, ByteString)
spanByte Word8
c ps :: ByteString
ps@(BS ForeignPtr Word8
x Int
l) =
forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x forall {b}. Ptr b -> IO (ByteString, ByteString)
g
where
g :: Ptr b -> IO (ByteString, ByteString)
g Ptr b
p = Int -> IO (ByteString, ByteString)
go Int
0
where
go :: Int -> IO (ByteString, ByteString)
go !Int
i | Int
i forall a. Ord a => a -> a -> Bool
>= Int
l = forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
ps, ByteString
empty)
| Bool
otherwise = do Word8
c' <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p Int
i
if Word8
c forall a. Eq a => a -> a -> Bool
/= Word8
c'
then 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 Int -> IO (ByteString, ByteString)
go (Int
iforall a. Num a => a -> a -> a
+Int
1)
{-# INLINE spanByte #-}
{-# RULES
"ByteString specialise span (x ==)" forall x.
span (x `eqWord8`) = spanByte x
"ByteString specialise span (== x)" forall x.
span (`eqWord8` x) = spanByte x
#-}
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
notforall 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
_ (BS ForeignPtr Word8
_ Int
0) = []
splitWith Word8 -> Bool
predicate (BS ForeignPtr Word8
fp Int
len) = Int -> Int -> ForeignPtr Word8 -> [ByteString]
splitWith0 Int
0 Int
len ForeignPtr Word8
fp
where splitWith0 :: Int -> Int -> ForeignPtr Word8 -> [ByteString]
splitWith0 !Int
off' !Int
len' !ForeignPtr Word8
fp' =
forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$
ForeignPtr Word8
-> Int -> Int -> Int -> ForeignPtr Word8 -> IO [ByteString]
splitLoop ForeignPtr Word8
fp Int
0 Int
off' Int
len' ForeignPtr Word8
fp'
splitLoop :: ForeignPtr Word8
-> Int -> Int -> Int
-> ForeignPtr Word8
-> IO [ByteString]
splitLoop :: ForeignPtr Word8
-> Int -> Int -> Int -> ForeignPtr Word8 -> IO [ByteString]
splitLoop ForeignPtr Word8
p Int
idx2 Int
off' Int
len' ForeignPtr Word8
fp' = Int -> IO [ByteString]
go Int
idx2
where
go :: Int -> IO [ByteString]
go Int
idx'
| Int
idx' forall a. Ord a => a -> a -> Bool
>= Int
len' = forall (m :: * -> *) a. Monad m => a -> m a
return [ForeignPtr Word8 -> Int -> ByteString
BS (forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
fp' Int
off') Int
idx']
| Bool
otherwise = do
Word8
w <- forall a. Storable a => ForeignPtr a -> Int -> IO a
peekFpByteOff ForeignPtr Word8
p (Int
off'forall a. Num a => a -> a -> a
+Int
idx')
if Word8 -> Bool
predicate Word8
w
then forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> ByteString
BS (forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
fp' Int
off') Int
idx' forall a. a -> [a] -> [a]
:
Int -> Int -> ForeignPtr Word8 -> [ByteString]
splitWith0 (Int
off'forall a. Num a => a -> a -> a
+Int
idx'forall a. Num a => a -> a -> a
+Int
1) (Int
len'forall a. Num a => a -> a -> a
-Int
idx'forall a. Num a => a -> a -> a
-Int
1) ForeignPtr Word8
fp')
else Int -> IO [ByteString]
go (Int
idx'forall a. Num a => a -> a -> a
+Int
1)
{-# INLINE splitWith #-}
split :: Word8 -> ByteString -> [ByteString]
split :: Word8 -> ByteString -> [ByteString]
split Word8
_ (BS ForeignPtr Word8
_ Int
0) = []
split Word8
w (BS ForeignPtr Word8
x Int
l) = Int -> [ByteString]
loop Int
0
where
loop :: Int -> [ByteString]
loop !Int
n =
let q :: Ptr Word8
q = forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
memchr (Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
n)
Word8
w (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
lforall a. Num a => a -> a -> a
-Int
n))
in if Ptr Word8
q forall a. Eq a => a -> a -> Bool
== forall {b}. Ptr b
nullPtr
then [ForeignPtr Word8 -> Int -> ByteString
BS (forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
x Int
n) (Int
lforall a. Num a => a -> a -> a
-Int
n)]
else let i :: Int
i = Ptr Word8
q forall a b. Ptr a -> Ptr b -> Int
`minusPtr` forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
x
in ForeignPtr Word8 -> Int -> ByteString
BS (forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
x Int
n) (Int
iforall a. Num a => a -> a -> a
-Int
n) forall a. a -> [a] -> [a]
: Int -> [ByteString]
loop (Int
iforall a. Num a => a -> a -> a
+Int
1)
{-# INLINE split #-}
group :: ByteString -> [ByteString]
group :: ByteString -> [ByteString]
group ByteString
xs = case ByteString -> Maybe (Word8, ByteString)
uncons ByteString
xs of
Maybe (Word8, ByteString)
Nothing -> []
Just (Word8
h, ByteString
_) -> ByteString
ys forall a. a -> [a] -> [a]
: ByteString -> [ByteString]
group ByteString
zs
where
(ByteString
ys, ByteString
zs) = Word8 -> ByteString -> (ByteString, ByteString)
spanByte Word8
h ByteString
xs
groupBy :: (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString]
groupBy :: (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString]
groupBy Word8 -> Word8 -> Bool
k ByteString
xs = case ByteString -> Maybe (Word8, ByteString)
uncons ByteString
xs of
Maybe (Word8, ByteString)
Nothing -> []
Just (Word8
h, ByteString
t) -> Int -> ByteString -> ByteString
unsafeTake Int
n ByteString
xs 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 forall a. Num a => a -> a -> a
+ (Word8 -> Bool) -> ByteString -> Int
findIndexOrLength (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word8 -> Bool
k Word8
h) ByteString
t
intercalate :: ByteString -> [ByteString] -> ByteString
intercalate :: ByteString -> [ByteString] -> ByteString
intercalate ByteString
_ [] = forall a. Monoid a => a
mempty
intercalate ByteString
_ [ByteString
x] = ByteString
x
intercalate (BS ForeignPtr Word8
sepPtr Int
sepLen) (BS ForeignPtr Word8
hPtr Int
hLen : [ByteString]
t) =
Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp Int
totalLen forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
dstPtr0 -> do
ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp ForeignPtr Word8
dstPtr0 ForeignPtr Word8
hPtr Int
hLen
let go :: ForeignPtr Word8 -> [ByteString] -> IO ()
go ForeignPtr Word8
_ [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
go ForeignPtr Word8
dstPtr (BS ForeignPtr Word8
chunkPtr Int
chunkLen : [ByteString]
chunks) = do
ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp ForeignPtr Word8
dstPtr ForeignPtr Word8
sepPtr Int
sepLen
let destPtr' :: ForeignPtr b
destPtr' = ForeignPtr Word8
dstPtr forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
sepLen
ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp forall {b}. ForeignPtr b
destPtr' ForeignPtr Word8
chunkPtr Int
chunkLen
ForeignPtr Word8 -> [ByteString] -> IO ()
go (forall {b}. ForeignPtr b
destPtr' forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
chunkLen) [ByteString]
chunks
ForeignPtr Word8 -> [ByteString] -> IO ()
go (ForeignPtr Word8
dstPtr0 forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
hLen) [ByteString]
t
where
totalLen :: Int
totalLen = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\Int
acc (BS ForeignPtr Word8
_ Int
chunkLen) -> Int
acc forall a. Num a => a -> a -> a
+ Int
chunkLen forall a. Num a => a -> a -> a
+ Int
sepLen) Int
hLen [ByteString]
t
{-# INLINE intercalate #-}
index :: HasCallStack => ByteString -> Int -> Word8
index :: HasCallStack => ByteString -> Int -> Word8
index ByteString
ps Int
n
| Int
n forall a. Ord a => a -> a -> Bool
< Int
0 = forall a. HasCallStack => FilePath -> FilePath -> a
moduleError FilePath
"index" (FilePath
"negative index: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Int
n)
| Int
n forall a. Ord a => a -> a -> Bool
>= ByteString -> Int
length ByteString
ps = forall a. HasCallStack => FilePath -> FilePath -> a
moduleError FilePath
"index" (FilePath
"index too large: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Int
n
forall a. [a] -> [a] -> [a]
++ FilePath
", length = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show (ByteString -> Int
length ByteString
ps))
| Bool
otherwise = ByteString
ps ByteString -> Int -> Word8
`unsafeIndex` Int
n
{-# INLINE index #-}
indexMaybe :: ByteString -> Int -> Maybe Word8
indexMaybe :: ByteString -> Int -> Maybe Word8
indexMaybe ByteString
ps Int
n
| Int
n forall a. Ord a => a -> a -> Bool
< Int
0 = forall a. Maybe a
Nothing
| Int
n forall a. Ord a => a -> a -> Bool
>= ByteString -> Int
length ByteString
ps = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! ByteString
ps ByteString -> Int -> Word8
`unsafeIndex` Int
n
{-# INLINE indexMaybe #-}
(!?) :: ByteString -> Int -> Maybe Word8
!? :: ByteString -> Int -> Maybe Word8
(!?) = ByteString -> Int -> Maybe Word8
indexMaybe
{-# INLINE (!?) #-}
elemIndex :: Word8 -> ByteString -> Maybe Int
elemIndex :: Word8 -> ByteString -> Maybe Int
elemIndex Word8
c (BS ForeignPtr Word8
x Int
l) = forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
Ptr Word8
q <- Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
memchr Ptr Word8
p Word8
c (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! if Ptr Word8
q forall a. Eq a => a -> a -> Bool
== forall {b}. Ptr b
nullPtr then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! Ptr Word8
q forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
p
{-# INLINE elemIndex #-}
elemIndexEnd :: Word8 -> ByteString -> Maybe Int
elemIndexEnd :: Word8 -> ByteString -> Maybe Int
elemIndexEnd = (Word8 -> Bool) -> ByteString -> Maybe Int
findIndexEnd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> a -> Bool
(==)
{-# INLINE elemIndexEnd #-}
elemIndices :: Word8 -> ByteString -> [Int]
elemIndices :: Word8 -> ByteString -> [Int]
elemIndices Word8
w (BS ForeignPtr Word8
x Int
l) = Int -> [Int]
loop Int
0
where
loop :: Int -> [Int]
loop !Int
n = forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
Ptr Word8
q <- Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
memchr (Ptr Word8
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
n) Word8
w (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
l forall a. Num a => a -> a -> a
- Int
n))
if Ptr Word8
q forall a. Eq a => a -> a -> Bool
== forall {b}. Ptr b
nullPtr
then forall (m :: * -> *) a. Monad m => a -> m a
return []
else let !i :: Int
i = Ptr Word8
q forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
p
in forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int
i forall a. a -> [a] -> [a]
: Int -> [Int]
loop (Int
i forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE elemIndices #-}
count :: Word8 -> ByteString -> Int
count :: Word8 -> ByteString -> Int
count Word8
w (BS ForeignPtr Word8
x Int
m) = forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> CSize -> Word8 -> IO CSize
c_count Ptr Word8
p (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 (BS ForeignPtr Word8
x Int
l) = forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ forall {a}. ForeignPtr a -> IO (Maybe Int)
g ForeignPtr Word8
x
where
g :: ForeignPtr a -> IO (Maybe Int)
g !ForeignPtr a
ptr = Int -> IO (Maybe Int)
go Int
0
where
go :: Int -> IO (Maybe Int)
go !Int
n | Int
n forall a. Ord a => a -> a -> Bool
>= Int
l = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
| Bool
otherwise = do Word8
w <- forall a. Storable a => ForeignPtr a -> IO a
peekFp forall a b. (a -> b) -> a -> b
$ ForeignPtr a
ptr forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
n
if Word8 -> Bool
k Word8
w
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Int
n)
else Int -> IO (Maybe Int)
go (Int
nforall a. Num a => a -> a -> a
+Int
1)
{-# INLINE [1] findIndex #-}
findIndexEnd :: (Word8 -> Bool) -> ByteString -> Maybe Int
findIndexEnd :: (Word8 -> Bool) -> ByteString -> Maybe Int
findIndexEnd Word8 -> Bool
k (BS ForeignPtr Word8
x Int
l) = forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> IO (Maybe Int)
g ForeignPtr Word8
x
where
g :: ForeignPtr Word8 -> IO (Maybe Int)
g !ForeignPtr Word8
ptr = Int -> IO (Maybe Int)
go (Int
lforall a. Num a => a -> a -> a
-Int
1)
where
go :: Int -> IO (Maybe Int)
go !Int
n | Int
n forall a. Ord a => a -> a -> Bool
< Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
| Bool
otherwise = do Word8
w <- forall a. Storable a => ForeignPtr a -> Int -> IO a
peekFpByteOff ForeignPtr Word8
ptr Int
n
if Word8 -> Bool
k Word8
w
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Int
n)
else Int -> IO (Maybe Int)
go (Int
nforall a. Num a => a -> a -> a
-Int
1)
{-# INLINE findIndexEnd #-}
findIndices :: (Word8 -> Bool) -> ByteString -> [Int]
findIndices :: (Word8 -> Bool) -> ByteString -> [Int]
findIndices Word8 -> Bool
p = Int -> ByteString -> [Int]
loop Int
0
where
loop :: Int -> ByteString -> [Int]
loop !Int
n !ByteString
qs = case (Word8 -> Bool) -> ByteString -> Maybe Int
findIndex Word8 -> Bool
p ByteString
qs of
Just !Int
i ->
let !j :: Int
j = Int
nforall a. Num a => a -> a -> a
+Int
i
in Int
j forall a. a -> [a] -> [a]
: Int -> ByteString -> [Int]
loop (Int
jforall a. Num a => a -> a -> a
+Int
1) (Int -> ByteString -> ByteString
unsafeDrop (Int
iforall a. Num a => a -> a -> a
+Int
1) ByteString
qs)
Maybe Int
Nothing -> []
{-# INLINE [1] findIndices #-}
{-# RULES
"ByteString specialise findIndex (x ==)" forall x. findIndex (x`eqWord8`) = elemIndex x
"ByteString specialise findIndex (== x)" forall x. findIndex (`eqWord8`x) = elemIndex x
"ByteString specialise findIndices (x ==)" forall x. findIndices (x`eqWord8`) = elemIndices x
"ByteString specialise findIndices (== x)" forall x. findIndices (`eqWord8`x) = elemIndices x
#-}
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
c Word8 -> ByteString -> Bool
`elem` ByteString
ps)
{-# INLINE notElem #-}
filter :: (Word8 -> Bool) -> ByteString -> ByteString
filter :: (Word8 -> Bool) -> ByteString -> ByteString
filter Word8 -> Bool
k = \ps :: ByteString
ps@(BS ForeignPtr Word8
pIn Int
l) ->
if ByteString -> Bool
null ByteString
ps
then ByteString
ps
else
forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$ Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString
createFpAndTrim Int
l forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
pOut -> do
let
go' :: ForeignPtr Word8 -> ForeignPtr Word8 -> IO (ForeignPtr Word8)
go' ForeignPtr Word8
pf ForeignPtr Word8
pt = ForeignPtr Word8 -> ForeignPtr Word8 -> IO (ForeignPtr Word8)
go ForeignPtr Word8
pf ForeignPtr Word8
pt
where
end :: ForeignPtr b
end = ForeignPtr Word8
pf forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
l
go :: ForeignPtr Word8 -> ForeignPtr Word8 -> IO (ForeignPtr Word8)
go !ForeignPtr Word8
f !ForeignPtr Word8
t | ForeignPtr Word8
f forall a. Eq a => a -> a -> Bool
== forall {b}. ForeignPtr b
end = forall (m :: * -> *) a. Monad m => a -> m a
return ForeignPtr Word8
t
| Bool
otherwise = do
Word8
w <- forall a. Storable a => ForeignPtr a -> IO a
peekFp ForeignPtr Word8
f
if Word8 -> Bool
k Word8
w
then forall a. Storable a => ForeignPtr a -> a -> IO ()
pokeFp ForeignPtr Word8
t Word8
w
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ForeignPtr Word8 -> ForeignPtr Word8 -> IO (ForeignPtr Word8)
go (ForeignPtr Word8
f forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
1) (ForeignPtr Word8
t forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
1)
else ForeignPtr Word8 -> ForeignPtr Word8 -> IO (ForeignPtr Word8)
go (ForeignPtr Word8
f forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
1) ForeignPtr Word8
t
ForeignPtr Word8
t <- ForeignPtr Word8 -> ForeignPtr Word8 -> IO (ForeignPtr Word8)
go' ForeignPtr Word8
pIn ForeignPtr Word8
pOut
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ForeignPtr Word8
t forall a b. ForeignPtr a -> ForeignPtr b -> Int
`minusForeignPtr` ForeignPtr Word8
pOut
{-# 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 -> forall a. a -> Maybe a
Just (ByteString
p ByteString -> Int -> Word8
`unsafeIndex` Int
n)
Maybe Int
_ -> 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 = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
do ForeignPtr Word8
p <- forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
len
let end :: ForeignPtr b
end = ForeignPtr Word8
p forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` (Int
len forall a. Num a => a -> a -> a
- Int
1)
ForeignPtr Word8
mid <- Int
-> ForeignPtr Word8 -> ForeignPtr Word8 -> IO (ForeignPtr Word8)
sep Int
0 ForeignPtr Word8
p forall {b}. ForeignPtr b
end
forall {b}. Storable b => ForeignPtr b -> ForeignPtr b -> IO ()
rev ForeignPtr Word8
mid forall {b}. ForeignPtr b
end
let i :: Int
i = ForeignPtr Word8
mid forall a b. ForeignPtr a -> ForeignPtr b -> Int
`minusForeignPtr` ForeignPtr Word8
p
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
p Int
i,
ForeignPtr Word8 -> Int -> ByteString
BS (ForeignPtr Word8
p forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
i) (Int
len forall a. Num a => a -> a -> a
- Int
i))
where
len :: Int
len = ByteString -> Int
length ByteString
s
incr :: ForeignPtr a -> ForeignPtr b
incr = (forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
1)
decr :: ForeignPtr a -> ForeignPtr b
decr = (forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` (-Int
1))
sep :: Int
-> ForeignPtr Word8 -> ForeignPtr Word8 -> IO (ForeignPtr Word8)
sep !Int
i !ForeignPtr Word8
p1 !ForeignPtr Word8
p2
| Int
i forall a. Eq a => a -> a -> Bool
== Int
len = forall (m :: * -> *) a. Monad m => a -> m a
return ForeignPtr Word8
p1
| Word8 -> Bool
f Word8
w = do forall a. Storable a => ForeignPtr a -> a -> IO ()
pokeFp ForeignPtr Word8
p1 Word8
w
Int
-> ForeignPtr Word8 -> ForeignPtr Word8 -> IO (ForeignPtr Word8)
sep (Int
i forall a. Num a => a -> a -> a
+ Int
1) (forall {a} {b}. ForeignPtr a -> ForeignPtr b
incr ForeignPtr Word8
p1) ForeignPtr Word8
p2
| Bool
otherwise = do forall a. Storable a => ForeignPtr a -> a -> IO ()
pokeFp ForeignPtr Word8
p2 Word8
w
Int
-> ForeignPtr Word8 -> ForeignPtr Word8 -> IO (ForeignPtr Word8)
sep (Int
i forall a. Num a => a -> a -> a
+ Int
1) ForeignPtr Word8
p1 (forall {a} {b}. ForeignPtr a -> ForeignPtr b
decr ForeignPtr Word8
p2)
where
w :: Word8
w = ByteString
s ByteString -> Int -> Word8
`unsafeIndex` Int
i
rev :: ForeignPtr b -> ForeignPtr b -> IO ()
rev !ForeignPtr b
p1 !ForeignPtr b
p2
| ForeignPtr b
p1 forall a. Ord a => a -> a -> Bool
>= ForeignPtr b
p2 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do b
a <- forall a. Storable a => ForeignPtr a -> IO a
peekFp ForeignPtr b
p1
b
b <- forall a. Storable a => ForeignPtr a -> IO a
peekFp ForeignPtr b
p2
forall a. Storable a => ForeignPtr a -> a -> IO ()
pokeFp ForeignPtr b
p1 b
b
forall a. Storable a => ForeignPtr a -> a -> IO ()
pokeFp ForeignPtr b
p2 b
a
ForeignPtr b -> ForeignPtr b -> IO ()
rev (forall {a} {b}. ForeignPtr a -> ForeignPtr b
incr ForeignPtr b
p1) (forall {a} {b}. ForeignPtr a -> ForeignPtr b
decr ForeignPtr b
p2)
isPrefixOf :: ByteString -> ByteString -> Bool
isPrefixOf :: ByteString -> ByteString -> Bool
isPrefixOf (BS ForeignPtr Word8
x1 Int
l1) (BS ForeignPtr Word8
x2 Int
l2)
| Int
l1 forall a. Eq a => a -> a -> Bool
== Int
0 = Bool
True
| Int
l2 forall a. Ord a => a -> a -> Bool
< Int
l1 = Bool
False
| Bool
otherwise = forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x1 forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p1 ->
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x2 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
p2 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l1)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! CInt
i forall a. Eq a => a -> a -> Bool
== CInt
0
stripPrefix :: ByteString -> ByteString -> Maybe ByteString
stripPrefix :: ByteString -> ByteString -> Maybe ByteString
stripPrefix bs1 :: ByteString
bs1@(BS ForeignPtr Word8
_ Int
l1) ByteString
bs2
| ByteString
bs1 ByteString -> ByteString -> Bool
`isPrefixOf` ByteString
bs2 = forall a. a -> Maybe a
Just (Int -> ByteString -> ByteString
unsafeDrop Int
l1 ByteString
bs2)
| Bool
otherwise = forall a. Maybe a
Nothing
isSuffixOf :: ByteString -> ByteString -> Bool
isSuffixOf :: ByteString -> ByteString -> Bool
isSuffixOf (BS ForeignPtr Word8
x1 Int
l1) (BS ForeignPtr Word8
x2 Int
l2)
| Int
l1 forall a. Eq a => a -> a -> Bool
== Int
0 = Bool
True
| Int
l2 forall a. Ord a => a -> a -> Bool
< Int
l1 = Bool
False
| Bool
otherwise = forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x1 forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p1 ->
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x2 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
p2 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
l2 forall a. Num a => a -> a -> a
- Int
l1)) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l1)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! CInt
i forall a. Eq a => a -> a -> Bool
== CInt
0
stripSuffix :: ByteString -> ByteString -> Maybe ByteString
stripSuffix :: ByteString -> ByteString -> Maybe ByteString
stripSuffix bs1 :: ByteString
bs1@(BS ForeignPtr Word8
_ Int
l1) bs2 :: ByteString
bs2@(BS ForeignPtr Word8
_ Int
l2)
| ByteString
bs1 ByteString -> ByteString -> Bool
`isSuffixOf` ByteString
bs2 = forall a. a -> Maybe a
Just (Int -> ByteString -> ByteString
unsafeTake (Int
l2 forall a. Num a => a -> a -> a
- Int
l1) ByteString
bs2)
| Bool
otherwise = forall a. Maybe a
Nothing
isInfixOf :: ByteString -> ByteString -> Bool
isInfixOf :: ByteString -> ByteString -> Bool
isInfixOf ByteString
p ByteString
s = ByteString -> Bool
null ByteString
p Bool -> Bool -> Bool
|| Bool -> Bool
not (ByteString -> Bool
null forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> (ByteString, ByteString)
breakSubstring ByteString
p ByteString
s)
isValidUtf8 :: ByteString -> Bool
isValidUtf8 :: ByteString -> Bool
isValidUtf8 (BS ForeignPtr Word8
ptr Int
len) = forall a. IO a -> a
accursedUnutterablePerformIO forall a b. (a -> b) -> a -> b
$ forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
ptr forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
CInt
i <- if Int
len forall a. Ord a => a -> a -> Bool
< Int
1000000
then Ptr Word8 -> CSize -> IO CInt
cIsValidUtf8 Ptr Word8
p (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
else Ptr Word8 -> CSize -> IO CInt
cIsValidUtf8Safe Ptr Word8
p (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ CInt
i forall a. Eq a => a -> a -> Bool
/= CInt
0
foreign import ccall unsafe "bytestring_is_valid_utf8" cIsValidUtf8
:: Ptr Word8 -> CSize -> IO CInt
foreign import ccall safe "bytestring_is_valid_utf8" cIsValidUtf8Safe
:: Ptr Word8 -> CSize -> IO CInt
breakSubstring :: ByteString
-> ByteString
-> (ByteString,ByteString)
breakSubstring :: ByteString -> ByteString -> (ByteString, ByteString)
breakSubstring ByteString
pat =
case Int
lp of
Int
0 -> (ByteString
empty,)
Int
1 -> Word8 -> ByteString -> (ByteString, ByteString)
breakByte (ByteString -> Word8
unsafeHead ByteString
pat)
Int
_ -> if Int
lp forall a. Num a => a -> a -> a
* Int
8 forall a. Ord a => a -> a -> Bool
<= 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 forall a. Ord a => a -> a -> Bool
< Int
lp = (ByteString
src,ByteString
empty)
| Bool
otherwise = Word32 -> Int -> (ByteString, ByteString)
search (ByteString -> Word32
rollingHash 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 = forall a. (a -> Word8 -> a) -> a -> ByteString -> a
foldl' (\Word32
h Word8
b -> Word32
h forall a. Num a => a -> a -> a
* Word32
k forall a. Num a => a -> a -> a
+ 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 forall a b. (Num a, Integral b) => a -> b -> a
^ Int
lp
get :: Int -> Word32
get = forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 forall a. Eq a => a -> a -> Bool
== Word32
hs Bool -> Bool -> Bool
&& ByteString
pat forall a. Eq a => a -> a -> Bool
== Int -> ByteString -> ByteString
unsafeTake Int
lp ByteString
b = (ByteString, ByteString)
u
| ByteString -> Int
length ByteString
src forall a. Ord a => a -> a -> Bool
<= Int
i = (ByteString
src,ByteString
empty)
| Bool
otherwise = Word32 -> Int -> (ByteString, ByteString)
search Word32
hs' (Int
i forall a. Num a => a -> a -> a
+ Int
1)
where
u :: (ByteString, ByteString)
u@(ByteString
_, ByteString
b) = Int -> ByteString -> (ByteString, ByteString)
unsafeSplitAt (Int
i forall a. Num a => a -> a -> a
- Int
lp) ByteString
src
hs' :: Word32
hs' = Word32
hs forall a. Num a => a -> a -> a
* Word32
k forall a. Num a => a -> a -> a
+
Int -> Word32
get Int
i forall a. Num a => a -> a -> a
-
Word32
m forall a. Num a => a -> a -> a
* Int -> Word32
get (Int
i 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 forall a. Ord a => a -> a -> Bool
< Int
lp = (ByteString
src,ByteString
empty)
| Bool
otherwise = Word -> Int -> (ByteString, ByteString)
search (ByteString -> Word
intoWord 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 = forall a. (a -> Word8 -> a) -> a -> ByteString -> a
foldl' (\Word
w Word8
b -> (Word
w forall a. Bits a => a -> Int -> a
`shiftL` Int
8) forall a. Bits a => a -> a -> a
.|. 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 forall a. Bits a => a -> Int -> a
`shiftL` (Int
8 forall a. Num a => a -> a -> a
* Int
lp)) forall a. Num a => a -> a -> a
- Word
1
search :: Word -> Int -> (ByteString, ByteString)
search !Word
w !Int
i
| Word
w forall a. Eq a => a -> a -> Bool
== Word
wp = Int -> ByteString -> (ByteString, ByteString)
unsafeSplitAt (Int
i forall a. Num a => a -> a -> a
- Int
lp) ByteString
src
| ByteString -> Int
length ByteString
src forall a. Ord a => a -> a -> Bool
<= Int
i = (ByteString
src, ByteString
empty)
| Bool
otherwise = Word -> Int -> (ByteString, ByteString)
search Word
w' (Int
i forall a. Num a => a -> a -> a
+ Int
1)
where
b :: Word
b = forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
unsafeIndex ByteString
src Int
i)
w' :: Word
w' = Word
mask forall a. Bits a => a -> a -> a
.&. ((Word
w forall a. Bits a => a -> Int -> a
`shiftL` Int
8) forall a. Bits a => a -> a -> a
.|. Word
b)
{-# INLINE shift #-}
zip :: ByteString -> ByteString -> [(Word8,Word8)]
zip :: ByteString -> ByteString -> [(Word8, Word8)]
zip ByteString
ps ByteString
qs = case ByteString -> Maybe (Word8, ByteString)
uncons ByteString
ps of
Maybe (Word8, ByteString)
Nothing -> []
Just (Word8
psH, ByteString
psT) -> case ByteString -> Maybe (Word8, ByteString)
uncons ByteString
qs of
Maybe (Word8, ByteString)
Nothing -> []
Just (Word8
qsH, ByteString
qsT) -> (Word8
psH, Word8
qsH) forall a. a -> [a] -> [a]
: ByteString -> ByteString -> [(Word8, Word8)]
zip ByteString
psT ByteString
qsT
zipWith :: (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
zipWith :: forall a. (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
zipWith Word8 -> Word8 -> a
f ByteString
ps ByteString
qs = case ByteString -> Maybe (Word8, ByteString)
uncons ByteString
ps of
Maybe (Word8, ByteString)
Nothing -> []
Just (Word8
psH, ByteString
psT) -> case ByteString -> Maybe (Word8, ByteString)
uncons ByteString
qs of
Maybe (Word8, ByteString)
Nothing -> []
Just (Word8
qsH, ByteString
qsT) -> Word8 -> Word8 -> a
f Word8
psH Word8
qsH forall a. a -> [a] -> [a]
: forall a. (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
zipWith Word8 -> Word8 -> a
f ByteString
psT ByteString
qsT
{-# NOINLINE [1] zipWith #-}
packZipWith :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> ByteString
packZipWith :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> ByteString
packZipWith Word8 -> Word8 -> Word8
f (BS ForeignPtr Word8
a Int
l) (BS ForeignPtr Word8
b Int
m) = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
Int -> (ForeignPtr Word8 -> IO ()) -> IO ByteString
createFp Int
len forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> ForeignPtr Word8 -> ForeignPtr Word8 -> IO ()
go ForeignPtr Word8
a ForeignPtr Word8
b
where
go :: ForeignPtr Word8 -> ForeignPtr Word8 -> ForeignPtr Word8 -> IO ()
go ForeignPtr Word8
p1 ForeignPtr Word8
p2 = Int -> ForeignPtr Word8 -> IO ()
zipWith_ Int
0
where
zipWith_ :: Int -> ForeignPtr Word8 -> IO ()
zipWith_ :: Int -> ForeignPtr Word8 -> IO ()
zipWith_ !Int
n !ForeignPtr Word8
r
| Int
n forall a. Ord a => a -> a -> Bool
>= Int
len = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
Word8
x <- forall a. Storable a => ForeignPtr a -> Int -> IO a
peekFpByteOff ForeignPtr Word8
p1 Int
n
Word8
y <- forall a. Storable a => ForeignPtr a -> Int -> IO a
peekFpByteOff ForeignPtr Word8
p2 Int
n
forall a b. Storable a => ForeignPtr b -> Int -> a -> IO ()
pokeFpByteOff ForeignPtr Word8
r Int
n (Word8 -> Word8 -> Word8
f Word8
x Word8
y)
Int -> ForeignPtr Word8 -> IO ()
zipWith_ (Int
nforall a. Num a => a -> a -> a
+Int
1) ForeignPtr Word8
r
len :: Int
len = forall a. Ord a => a -> a -> a
min Int
l Int
m
{-# INLINE packZipWith #-}
{-# RULES
"ByteString specialise zipWith" forall (f :: Word8 -> Word8 -> Word8) p q .
zipWith f p q = unpack (packZipWith f p q)
#-}
unzip :: [(Word8,Word8)] -> (ByteString,ByteString)
unzip :: [(Word8, Word8)] -> (ByteString, ByteString)
unzip [(Word8, Word8)]
ls = ([Word8] -> ByteString
pack (forall a b. (a -> b) -> [a] -> [b]
P.map forall a b. (a, b) -> a
fst [(Word8, Word8)]
ls), [Word8] -> ByteString
pack (forall a b. (a -> b) -> [a] -> [b]
P.map forall a b. (a, b) -> b
snd [(Word8, Word8)]
ls))
{-# INLINE unzip #-}
inits :: ByteString -> [ByteString]
inits :: ByteString -> [ByteString]
inits ByteString
bs = forall a. NonEmpty a -> [a]
NE.toList forall a b. (a -> b) -> a -> b
$! ByteString -> NonEmpty ByteString
initsNE ByteString
bs
initsNE :: ByteString -> NonEmpty ByteString
initsNE :: ByteString -> NonEmpty ByteString
initsNE (BS ForeignPtr Word8
x Int
len) = ByteString
empty forall a. a -> [a] -> NonEmpty a
:| [ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
x Int
n | Int
n <- [Int
1..Int
len]]
tails :: ByteString -> [ByteString]
tails :: ByteString -> [ByteString]
tails ByteString
bs = forall a. NonEmpty a -> [a]
NE.toList forall a b. (a -> b) -> a -> b
$! ByteString -> NonEmpty ByteString
tailsNE ByteString
bs
tailsNE :: ByteString -> NonEmpty ByteString
tailsNE :: ByteString -> NonEmpty ByteString
tailsNE ByteString
p | ByteString -> Bool
null ByteString
p = ByteString
empty forall a. a -> [a] -> NonEmpty a
:| []
| Bool
otherwise = ByteString
p forall a. a -> [a] -> NonEmpty a
:| ByteString -> [ByteString]
tails (ByteString -> ByteString
unsafeTail ByteString
p)
sort :: ByteString -> ByteString
sort :: ByteString -> ByteString
sort (BS ForeignPtr Word8
input Int
l)
| Int
l forall a. Ord a => a -> a -> Bool
<= Int
20 = Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp Int
l forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
destFP -> do
ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp ForeignPtr Word8
destFP ForeignPtr Word8
input Int
l
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
destFP forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dest -> Ptr Word8 -> CSize -> IO ()
c_sort Ptr Word8
dest (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
| Bool
otherwise = Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp Int
l forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
p -> forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
256 forall a b. (a -> b) -> a -> b
$ \Ptr Int
arr -> do
forall a. Ptr a -> Word8 -> Int -> IO ()
fillBytes (forall a b. Ptr a -> Ptr b
castPtr Ptr Int
arr) Word8
0 (Int
256 forall a. Num a => a -> a -> a
* forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: Int))
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
input (\Ptr Word8
x -> Ptr Int -> Ptr Word8 -> Int -> IO ()
countOccurrences Ptr Int
arr Ptr Word8
x Int
l)
let go :: Int -> Ptr b -> IO ()
go Int
256 !Ptr b
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
go Int
i !Ptr b
ptr = do Int
n <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Int
arr Int
i
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n forall a. Eq a => a -> a -> Bool
/= Int
0) forall a b. (a -> b) -> a -> b
$
forall a. Ptr a -> Word8 -> Int -> IO ()
fillBytes Ptr b
ptr (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word8 Int
i) Int
n
Int -> Ptr b -> IO ()
go (Int
i forall a. Num a => a -> a -> a
+ Int
1) (Ptr b
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
p (forall {b}. Int -> Ptr b -> IO ()
go Int
0)
where
countOccurrences :: Ptr Int -> Ptr Word8 -> Int -> IO ()
countOccurrences :: Ptr Int -> Ptr Word8 -> Int -> IO ()
countOccurrences !Ptr Int
counts !Ptr Word8
str !Int
len = Int -> IO ()
go Int
0
where
go :: Int -> IO ()
go !Int
i | Int
i forall a. Eq a => a -> a -> Bool
== Int
len = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do Int
k <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
str Int
i
Int
x <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Int
counts Int
k
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Int
counts Int
k (Int
x forall a. Num a => a -> a -> a
+ Int
1)
Int -> IO ()
go (Int
i forall a. Num a => a -> a -> a
+ Int
1)
useAsCString :: ByteString -> (CString -> IO a) -> IO a
useAsCString :: forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString (BS ForeignPtr Word8
fp Int
l) CString -> IO a
action =
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
lforall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$ \Ptr Word8
buf -> do
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
buf Ptr Word8
p Int
l
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
buf Int
l (Word8
0::Word8)
CString -> IO a
action (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
buf)
useAsCStringLen :: ByteString -> (CStringLen -> IO a) -> IO a
useAsCStringLen :: forall a. ByteString -> (CStringLen -> IO a) -> IO a
useAsCStringLen p :: ByteString
p@(BS ForeignPtr Word8
_ Int
l) CStringLen -> IO a
f = forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString ByteString
p 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, 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 forall a. Ord a => a -> a -> Bool
>= Int
0 = Int -> (ForeignPtr Word8 -> IO ()) -> IO ByteString
createFp Int
len forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
fp ->
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
p (forall a b. Ptr a -> Ptr b
castPtr CString
cstr) Int
len
packCStringLen (CString
_, Int
len) =
forall a. HasCallStack => FilePath -> FilePath -> IO a
moduleErrorIO FilePath
"packCStringLen" (FilePath
"negative length: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Int
len)
copy :: ByteString -> ByteString
copy :: ByteString -> ByteString
copy (BS ForeignPtr Word8
x Int
l) = Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp Int
l forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
p -> ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp ForeignPtr Word8
p ForeignPtr Word8
x 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 =
forall a. FilePath -> Handle -> (Handle__ -> IO a) -> IO a
wantReadableHandle_ FilePath
"Data.ByteString.hGetLine" Handle
h 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 <- forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
if 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') <- forall dev.
BufferedIO dev =>
dev -> Buffer Word8 -> IO (Int, Buffer Word8)
Buffered.fillReadBuffer dev
haDevice Buffer Word8
buf
if Int
r forall a. Eq a => a -> a -> Bool
== Int
0
then do 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 forall a. Ord a => a -> a -> Bool
> Int
0
then Int -> [ByteString] -> IO ByteString
mkBigPS Int
len [ByteString]
xss
else 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 :: forall e. Buffer e -> RawBuffer e
bufRaw=ForeignPtr Word8
raw, bufR :: forall e. Buffer e -> Int
bufR=Int
w, bufL :: forall e. Buffer e -> Int
bufL=Int
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 forall a. Num a => a -> a -> a
+ Int
off 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 forall a. Eq a => a -> a -> Bool
/= Int
w
then do if Int
w forall a. Eq a => a -> a -> Bool
== Int
off forall a. Num a => a -> a -> a
+ Int
1
then 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 forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
buf{ bufL :: Int
bufL = Int
off forall a. Num a => a -> a -> a
+ Int
1 }
Int -> [ByteString] -> IO ByteString
mkBigPS Int
new_len (ByteString
xsforall 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
xsforall a. a -> [a] -> [a]
:[ByteString]
xss)
findEOL :: Int -> Int -> ForeignPtr Word8 -> IO Int
findEOL Int
r Int
w ForeignPtr Word8
raw
| Int
r forall a. Eq a => a -> a -> Bool
== Int
w = 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 forall a. Eq a => a -> a -> Bool
== forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
'\n')
then forall (m :: * -> *) a. Monad m => a -> m a
return Int
r
else Int -> Int -> ForeignPtr Word8 -> IO Int
findEOL (Int
rforall 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 -> (ForeignPtr Word8 -> IO ()) -> IO ByteString
createFp Int
len forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
fp -> ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp ForeignPtr Word8
fp (ForeignPtr Word8
buf forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
start) Int
len
where
len :: Int
len = Int
end forall a. Num a => a -> a -> a
- Int
start
mkBigPS :: Int -> [ByteString] -> IO ByteString
mkBigPS :: Int -> [ByteString] -> IO ByteString
mkBigPS Int
_ [ByteString
ps] = forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
ps
mkBigPS Int
_ [ByteString]
pss = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! [ByteString] -> ByteString
concat (forall a. [a] -> [a]
P.reverse [ByteString]
pss)
hPut :: Handle -> ByteString -> IO ()
hPut :: Handle -> ByteString -> IO ()
hPut Handle
_ (BS ForeignPtr Word8
_ Int
0) = forall (m :: * -> *) a. Monad m => a -> m a
return ()
hPut Handle
h (BS ForeignPtr Word8
ps Int
l) = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
ps forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p-> forall a. Handle -> Ptr a -> Int -> IO ()
hPutBuf Handle
h Ptr Word8
p Int
l
hPutNonBlocking :: Handle -> ByteString -> IO ByteString
hPutNonBlocking :: Handle -> ByteString -> IO ByteString
hPutNonBlocking Handle
h bs :: ByteString
bs@(BS ForeignPtr Word8
ps Int
l) = do
Int
bytesWritten <- forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
ps forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p-> forall a. Handle -> Ptr a -> Int -> IO Int
hPutBufNonBlocking Handle
h Ptr Word8
p Int
l
forall (m :: * -> *) a. Monad m => a -> m a
return 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
putStr :: ByteString -> IO ()
putStr :: ByteString -> IO ()
putStr = Handle -> ByteString -> IO ()
hPut Handle
stdout
hGet :: Handle -> Int -> IO ByteString
hGet :: Handle -> Int -> IO ByteString
hGet Handle
h Int
i
| Int
i forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString
createFpAndTrim Int
i forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
fp ->
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
h Ptr Word8
p Int
i
| Int
i forall a. Eq a => a -> a -> Bool
== Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
empty
| Bool
otherwise = forall a. Handle -> FilePath -> Int -> IO a
illegalBufferSize Handle
h FilePath
"hGet" Int
i
hGetNonBlocking :: Handle -> Int -> IO ByteString
hGetNonBlocking :: Handle -> Int -> IO ByteString
hGetNonBlocking Handle
h Int
i
| Int
i forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString
createFpAndTrim Int
i forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
fp ->
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> forall a. Handle -> Ptr a -> Int -> IO Int
hGetBufNonBlocking Handle
h Ptr Word8
p Int
i
| Int
i forall a. Eq a => a -> a -> Bool
== Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
empty
| Bool
otherwise = forall a. Handle -> FilePath -> Int -> IO a
illegalBufferSize Handle
h FilePath
"hGetNonBlocking" Int
i
hGetSome :: Handle -> Int -> IO ByteString
hGetSome :: Handle -> Int -> IO ByteString
hGetSome Handle
hh Int
i
| Int
i forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString
createFpAndTrim Int
i forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
fp ->
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> forall a. Handle -> Ptr a -> Int -> IO Int
hGetBufSome Handle
hh Ptr Word8
p Int
i
| Int
i forall a. Eq a => a -> a -> Bool
== Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
empty
| Bool
otherwise = forall a. Handle -> FilePath -> Int -> IO a
illegalBufferSize Handle
hh FilePath
"hGetSome" Int
i
illegalBufferSize :: Handle -> String -> Int -> IO a
illegalBufferSize :: forall a. Handle -> FilePath -> Int -> IO a
illegalBufferSize Handle
handle FilePath
fn Int
sz =
forall a. IOException -> IO a
ioError (IOErrorType
-> FilePath -> Maybe Handle -> Maybe FilePath -> IOException
mkIOError IOErrorType
illegalOperationErrorType FilePath
msg (forall a. a -> Maybe a
Just Handle
handle) forall a. Maybe a
Nothing)
where
msg :: FilePath
msg = FilePath
fn forall a. [a] -> [a] -> [a]
++ FilePath
": illegal ByteString size " forall a. [a] -> [a] -> [a]
++ forall a. Show a => Int -> a -> ShowS
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
forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
hClose Handle
hnd
if ByteString -> Int
length ByteString
bs forall a. Ord a => a -> a -> Bool
< Int
900
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString
copy ByteString
bs
else 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 <- forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
sz
Int
readcount <- forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
buf -> forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
hnd Ptr Word8
buf Int
sz
let chunk :: ByteString
chunk = ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
fp Int
readcount
if Int
readcount forall a. Ord a => a -> a -> Bool
< Int
sz Bool -> Bool -> Bool
&& Int
sz forall a. Ord a => a -> a -> Bool
> Int
0
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! [ByteString] -> ByteString
concat (forall a. [a] -> [a]
P.reverse (ByteString
chunk forall a. a -> [a] -> [a]
: [ByteString]
chunks))
else [ByteString] -> Int -> Int -> IO ByteString
readChunks (ByteString
chunk forall a. a -> [a] -> [a]
: [ByteString]
chunks) Int
sz' ((Int
szforall a. Num a => a -> a -> a
+Int
sz') 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
transformer forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO ByteString
getContents
readFile :: FilePath -> IO ByteString
readFile :: FilePath -> IO ByteString
readFile FilePath
f =
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
f IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
Integer
filesz <- forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (Handle -> IO Integer
hFileSize Handle
h) IOException -> IO Integer
useZeroIfNotRegularFile
let readsz :: Int
readsz = (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
filesz forall a. Ord a => a -> a -> a
`max` Int
0) forall a. Num a => a -> a -> a
+ Int
1
Handle -> Int -> Int -> IO ByteString
hGetContentsSizeHint Handle
h Int
readsz (Int
readsz forall a. Ord a => a -> a -> a
`max` Int
255)
where
useZeroIfNotRegularFile :: IOException -> IO Integer
useZeroIfNotRegularFile :: IOException -> IO Integer
useZeroIfNotRegularFile IOException
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Integer
0
modifyFile :: IOMode -> FilePath -> ByteString -> IO ()
modifyFile :: IOMode -> FilePath -> ByteString -> IO ()
modifyFile IOMode
mode FilePath
f ByteString
txt = forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
f IOMode
mode (Handle -> ByteString -> IO ()
`hPut` ByteString
txt)
writeFile :: FilePath -> ByteString -> IO ()
writeFile :: FilePath -> ByteString -> IO ()
writeFile = IOMode -> FilePath -> ByteString -> IO ()
modifyFile IOMode
WriteMode
appendFile :: FilePath -> ByteString -> IO ()
appendFile :: FilePath -> ByteString -> IO ()
appendFile = IOMode -> FilePath -> ByteString -> IO ()
modifyFile IOMode
AppendMode
errorEmptyList :: HasCallStack => String -> a
errorEmptyList :: forall a. HasCallStack => FilePath -> a
errorEmptyList FilePath
fun = forall a. HasCallStack => FilePath -> FilePath -> a
moduleError FilePath
fun FilePath
"empty ByteString"
{-# NOINLINE errorEmptyList #-}
moduleError :: HasCallStack => String -> String -> a
moduleError :: forall a. HasCallStack => FilePath -> FilePath -> a
moduleError FilePath
fun FilePath
msg = forall a. HasCallStack => FilePath -> a
error (FilePath -> ShowS
moduleErrorMsg FilePath
fun FilePath
msg)
{-# NOINLINE moduleError #-}
moduleErrorIO :: HasCallStack => String -> String -> IO a
moduleErrorIO :: forall a. HasCallStack => FilePath -> FilePath -> IO a
moduleErrorIO FilePath
fun FilePath
msg = forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IOException
userError forall a b. (a -> b) -> a -> b
$ FilePath -> ShowS
moduleErrorMsg FilePath
fun FilePath
msg
{-# NOINLINE moduleErrorIO #-}
moduleErrorMsg :: String -> String -> String
moduleErrorMsg :: FilePath -> ShowS
moduleErrorMsg FilePath
fun FilePath
msg = FilePath
"Data.ByteString." forall a. [a] -> [a] -> [a]
++ FilePath
fun forall a. [a] -> [a] -> [a]
++ Char
':'forall a. a -> [a] -> [a]
:Char
' 'forall a. a -> [a] -> [a]
:FilePath
msg
findFromEndUntil :: (Word8 -> Bool) -> ByteString -> Int
findFromEndUntil :: (Word8 -> Bool) -> ByteString -> Int
findFromEndUntil Word8 -> Bool
f ps :: ByteString
ps@(BS ForeignPtr Word8
_ Int
l) = case ByteString -> Maybe (ByteString, Word8)
unsnoc ByteString
ps of
Maybe (ByteString, Word8)
Nothing -> Int
0
Just (ByteString
b, Word8
c) ->
if Word8 -> Bool
f Word8
c
then Int
l
else (Word8 -> Bool) -> ByteString -> Int
findFromEndUntil Word8 -> Bool
f ByteString
b