{-# 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.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 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
unsafeDrop (Word8 -> Int
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 b. (Word8 -> b -> b) -> b -> b) -> [Word8]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (ByteString -> (Word8 -> b -> b) -> b -> b
forall a. ByteString -> (Word8 -> a -> a) -> a -> a
unpackFoldr ByteString
bs)
{-# INLINE unpack #-}
unpackFoldr :: ByteString -> (Word8 -> a -> a) -> a -> a
unpackFoldr :: forall a. ByteString -> (Word8 -> a -> a) -> a -> a
unpackFoldr ByteString
bs Word8 -> a -> a
k a
z = (Word8 -> a -> a) -> a -> ByteString -> a
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
foldr Word8 -> a -> a
k a
z ByteString
bs
{-# INLINE [0] unpackFoldr #-}
{-# RULES
"ByteString unpack-list" [1] forall bs .
unpackFoldr bs (:) [] = unpackBytes bs
#-}
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 IO CStringLen -> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. IO a -> (a -> IO b) -> IO b
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
ByteString -> (CStringLen -> IO FilePath) -> IO FilePath
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) = Bool -> Bool -> Bool
forall a. HasCallStack => Bool -> a -> a
assert (Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
{-# INLINE null #-}
length :: ByteString -> Int
length :: ByteString -> Int
length (BS ForeignPtr Word8
_ Int
l) = Bool -> Int -> Int
forall a. HasCallStack => Bool -> a -> a
assert (Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) Int
l
{-# INLINE length #-}
infixr 5 `cons`
infixl 5 `snoc`
cons :: Word8 -> ByteString -> ByteString
cons :: Word8 -> ByteString -> ByteString
cons Word8
c (BS ForeignPtr Word8
x Int
len) = Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp (FilePath -> Int -> Int -> Int
checkedAdd FilePath
"cons" Int
len Int
1) ((ForeignPtr Word8 -> IO ()) -> ByteString)
-> (ForeignPtr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
p -> do
ForeignPtr Word8 -> Word8 -> IO ()
forall a. Storable a => ForeignPtr a -> a -> IO ()
pokeFp ForeignPtr Word8
p Word8
c
ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp (ForeignPtr Word8
p ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
1) ForeignPtr Word8
x Int
len
{-# INLINE cons #-}
snoc :: ByteString -> Word8 -> ByteString
snoc :: ByteString -> Word8 -> ByteString
snoc (BS ForeignPtr Word8
x Int
len) Word8
c = Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp (FilePath -> Int -> Int -> Int
checkedAdd FilePath
"snoc" Int
len Int
1) ((ForeignPtr Word8 -> IO ()) -> ByteString)
-> (ForeignPtr Word8 -> IO ()) -> ByteString
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
len
ForeignPtr Word8 -> Word8 -> IO ()
forall a. Storable a => ForeignPtr a -> a -> IO ()
pokeFp (ForeignPtr Word8
p ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
len) Word8
c
{-# INLINE snoc #-}
head :: HasCallStack => ByteString -> Word8
head :: HasCallStack => ByteString -> Word8
head (BS ForeignPtr Word8
x Int
l)
| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = FilePath -> Word8
forall a. HasCallStack => FilePath -> a
errorEmptyList FilePath
"head"
| Bool
otherwise = IO Word8 -> Word8
forall a. IO a -> a
accursedUnutterablePerformIO (IO Word8 -> Word8) -> IO Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO Word8) -> IO Word8)
-> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> IO Word8
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = FilePath -> ByteString
forall a. HasCallStack => FilePath -> a
errorEmptyList FilePath
"tail"
| Bool
otherwise = ForeignPtr Word8 -> Int -> ByteString
BS (ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
p Int
1) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
{-# INLINE tail #-}
uncons :: ByteString -> Maybe (Word8, ByteString)
uncons :: ByteString -> Maybe (Word8, ByteString)
uncons (BS ForeignPtr Word8
x Int
l)
| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Maybe (Word8, ByteString)
forall a. Maybe a
Nothing
| Bool
otherwise = (Word8, ByteString) -> Maybe (Word8, ByteString)
forall a. a -> Maybe a
Just (IO Word8 -> Word8
forall a. IO a -> a
accursedUnutterablePerformIO (IO Word8 -> Word8) -> IO Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x
((Ptr Word8 -> IO Word8) -> IO Word8)
-> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p,
ForeignPtr Word8 -> Int -> ByteString
BS (ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
x Int
1) (Int
lInt -> Int -> Int
forall 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 = FilePath -> Word8
forall a. HasCallStack => FilePath -> a
errorEmptyList FilePath
"last"
| Bool
otherwise = IO Word8 -> Word8
forall a. IO a -> a
accursedUnutterablePerformIO (IO Word8 -> Word8) -> IO Word8 -> Word8
forall a b. (a -> b) -> a -> b
$
ForeignPtr Word8 -> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO Word8) -> IO Word8)
-> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
p (Int
lInt -> Int -> Int
forall 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 = FilePath -> ByteString
forall a. HasCallStack => FilePath -> a
errorEmptyList FilePath
"init"
| Bool
otherwise = ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
p (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
{-# INLINE init #-}
unsnoc :: ByteString -> Maybe (ByteString, Word8)
unsnoc :: ByteString -> Maybe (ByteString, Word8)
unsnoc (BS ForeignPtr Word8
x Int
l)
| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Maybe (ByteString, Word8)
forall a. Maybe a
Nothing
| Bool
otherwise = (ByteString, Word8) -> Maybe (ByteString, Word8)
forall a. a -> Maybe a
Just (ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
x (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1),
IO Word8 -> Word8
forall a. IO a -> a
accursedUnutterablePerformIO (IO Word8 -> Word8) -> IO Word8 -> Word8
forall a b. (a -> b) -> a -> b
$
ForeignPtr Word8 -> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO Word8) -> IO Word8)
-> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
p (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
{-# INLINE unsnoc #-}
append :: ByteString -> ByteString -> ByteString
append :: ByteString -> ByteString -> ByteString
append = ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
mappend
{-# INLINE append #-}
map :: (Word8 -> Word8) -> ByteString -> ByteString
map :: (Word8 -> Word8) -> ByteString -> ByteString
map Word8 -> Word8
f (BS ForeignPtr Word8
srcPtr Int
len) = Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp Int
len ((ForeignPtr Word8 -> IO ()) -> ByteString)
-> (ForeignPtr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
dstPtr -> ForeignPtr Word8 -> ForeignPtr Word8 -> IO ()
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
Word8
x <- ForeignPtr Word8 -> Int -> IO Word8
forall a. Storable a => ForeignPtr a -> Int -> IO a
peekFpByteOff ForeignPtr Word8
p1 Int
n
ForeignPtr b -> Int -> Word8 -> IO ()
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
nInt -> Int -> Int
forall 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 ((ForeignPtr Word8 -> IO ()) -> ByteString)
-> (ForeignPtr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
fp ->
ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
f ->
Ptr Word8 -> Ptr Word8 -> CSize -> IO ()
c_reverse Ptr Word8
p Ptr Word8
f (Int -> CSize
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = ByteString
ps
| Bool
otherwise = Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ((ForeignPtr Word8 -> IO ()) -> ByteString)
-> (ForeignPtr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
fp ->
ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
f ->
Ptr Word8 -> Ptr Word8 -> CSize -> Word8 -> IO ()
c_intersperse Ptr Word8
p Ptr Word8
f (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) Word8
c
transpose :: [ByteString] -> [ByteString]
transpose :: [ByteString] -> [ByteString]
transpose = ([Word8] -> ByteString) -> [[Word8]] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
P.map [Word8] -> ByteString
pack ([[Word8]] -> [ByteString])
-> ([ByteString] -> [[Word8]]) -> [ByteString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Word8]] -> [[Word8]]
forall a. [[a]] -> [[a]]
List.transpose ([[Word8]] -> [[Word8]])
-> ([ByteString] -> [[Word8]]) -> [ByteString] -> [[Word8]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [Word8]) -> [ByteString] -> [[Word8]]
forall a b. (a -> b) -> [a] -> [b]
P.map ByteString -> [Word8]
unpack
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 = ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fp Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1)
go :: Ptr Word8 -> a
go !Ptr Word8
p | Ptr Word8
p Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
forall {b}. Ptr b
end = a
z
| Bool
otherwise = let !x :: Word8
x = IO Word8 -> Word8
forall a. IO a -> a
accursedUnutterablePerformIO (IO Word8 -> Word8) -> IO Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ do
Word8
x' <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p
ForeignPtr Word8 -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Word8
fp
Word8 -> IO Word8
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
x'
in a -> Word8 -> a
f (Ptr Word8 -> a
go (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
1))) Word8
x
in
Ptr Word8 -> a
go (Ptr Any
forall {b}. Ptr b
end Ptr Any -> Int -> Ptr Word8
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 ForeignPtr Word8 -> Int -> ForeignPtr b
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 ForeignPtr Word8 -> ForeignPtr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== ForeignPtr Word8
forall {b}. ForeignPtr b
end = a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
z
| Bool
otherwise = do Word8
x <- ForeignPtr Word8 -> IO Word8
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 ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
1)
in
IO a -> a
forall a. IO a -> a
accursedUnutterablePerformIO (IO a -> a) -> IO a -> a
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 = ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fp
end :: Ptr b
end = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
go :: Ptr Word8 -> a
go !Ptr Word8
p | Ptr Word8
p Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
forall {b}. Ptr b
end = a
z
| Bool
otherwise = let !x :: Word8
x = IO Word8 -> Word8
forall a. IO a -> a
accursedUnutterablePerformIO (IO Word8 -> Word8) -> IO Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ do
Word8
x' <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
p
ForeignPtr Word8 -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Word8
fp
Word8 -> IO Word8
forall a. a -> IO a
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 Ptr Word8 -> Int -> Ptr Word8
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 (ForeignPtr Any
forall {b}. ForeignPtr b
end ForeignPtr Any -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
len)
where
end :: ForeignPtr b
end = ForeignPtr a
ptr ForeignPtr a -> Int -> ForeignPtr b
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 ForeignPtr Word8 -> ForeignPtr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== ForeignPtr Word8
forall {b}. ForeignPtr b
end = a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
z
| Bool
otherwise = do Word8
x <- ForeignPtr Word8 -> IO Word8
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 ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` (-Int
1))
in
IO a -> a
forall a. IO a -> a
accursedUnutterablePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> IO a
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 -> FilePath -> Word8
forall a. HasCallStack => FilePath -> a
errorEmptyList FilePath
"foldl1"
Just (Word8
h, ByteString
t) -> (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> Word8
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 -> FilePath -> Word8
forall a. HasCallStack => FilePath -> a
errorEmptyList FilePath
"foldl1'"
Just (Word8
h, ByteString
t) -> (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> Word8
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 -> FilePath -> Word8
forall a. HasCallStack => FilePath -> a
errorEmptyList FilePath
"foldr1"
Just (ByteString
b, Word8
c) -> (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> Word8
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 -> FilePath -> Word8
forall a. HasCallStack => FilePath -> a
errorEmptyList FilePath
"foldr1'"
Just (ByteString
b, Word8
c) -> (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> Word8
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 = [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
concatMap :: (Word8 -> ByteString) -> ByteString -> ByteString
concatMap :: (Word8 -> ByteString) -> ByteString -> ByteString
concatMap Word8 -> ByteString
f = [ByteString] -> ByteString
concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> [ByteString] -> [ByteString])
-> [ByteString] -> ByteString -> [ByteString]
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
foldr ((:) (ByteString -> [ByteString] -> [ByteString])
-> (Word8 -> ByteString) -> Word8 -> [ByteString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString
f) []
any :: (Word8 -> Bool) -> ByteString -> Bool
any :: (Word8 -> Bool) -> ByteString -> Bool
any Word8 -> Bool
_ (BS ForeignPtr Word8
_ Int
0) = Bool
False
any Word8 -> Bool
f (BS ForeignPtr Word8
x Int
len) = IO Bool -> Bool
forall a. IO a -> a
accursedUnutterablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
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 ForeignPtr Word8 -> Int -> ForeignPtr b
forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
len
go :: ForeignPtr Word8 -> IO Bool
go !ForeignPtr Word8
p | ForeignPtr Word8
p ForeignPtr Word8 -> ForeignPtr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== ForeignPtr Word8
forall {b}. ForeignPtr b
end = Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
| Bool
otherwise = do Word8
c <- ForeignPtr Word8 -> IO Word8
forall a. Storable a => ForeignPtr a -> IO a
peekFp ForeignPtr Word8
p
if Word8 -> Bool
f Word8
c then Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else ForeignPtr Word8 -> IO Bool
go (ForeignPtr Word8
p ForeignPtr Word8 -> Int -> ForeignPtr Word8
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) = IO Bool -> Bool
forall a. IO a -> a
accursedUnutterablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
Ptr Word8
q <- Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
memchr Ptr Word8
p Word8
c (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$! Ptr Word8
q Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Word8
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) = IO Bool -> Bool
forall a. IO a -> a
accursedUnutterablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
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 ForeignPtr Word8 -> Int -> ForeignPtr b
forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
len
go :: ForeignPtr Word8 -> IO Bool
go !ForeignPtr Word8
p | ForeignPtr Word8
p ForeignPtr Word8 -> ForeignPtr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== ForeignPtr Word8
forall {b}. ForeignPtr b
end = Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
| Bool
otherwise = do Word8
c <- ForeignPtr Word8 -> IO Word8
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 ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
1)
else Bool -> IO Bool
forall a. a -> IO a
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 = FilePath -> Word8
forall a. HasCallStack => FilePath -> a
errorEmptyList FilePath
"maximum"
| Bool
otherwise = IO Word8 -> Word8
forall a. IO a -> a
accursedUnutterablePerformIO (IO Word8 -> Word8) -> IO Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO Word8) -> IO Word8)
-> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
Ptr Word8 -> CSize -> IO Word8
c_maximum Ptr Word8
p (Int -> CSize
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 = FilePath -> Word8
forall a. HasCallStack => FilePath -> a
errorEmptyList FilePath
"minimum"
| Bool
otherwise = IO Word8 -> Word8
forall a. IO a -> a
accursedUnutterablePerformIO (IO Word8 -> Word8) -> IO Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO Word8) -> IO Word8)
-> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
Ptr Word8 -> CSize -> IO Word8
c_minimum Ptr Word8
p (Int -> CSize
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) -> IO (acc, ByteString) -> (acc, ByteString)
forall a. IO a -> a
unsafeDupablePerformIO (IO (acc, ByteString) -> (acc, ByteString))
-> IO (acc, ByteString) -> (acc, ByteString)
forall a b. (a -> b) -> a -> b
$ do
ForeignPtr Word8
gp <- Int -> IO (ForeignPtr Word8)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = acc -> IO acc
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return acc
s
| Bool
otherwise = do
Word8
x <- ForeignPtr Word8 -> Int -> IO Word8
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
ForeignPtr b -> Int -> Word8 -> IO ()
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
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
acc
acc' <- ForeignPtr Word8 -> ForeignPtr Word8 -> IO acc
forall {b}. ForeignPtr Word8 -> ForeignPtr b -> IO acc
go ForeignPtr Word8
a ForeignPtr Word8
gp
(acc, ByteString) -> IO (acc, ByteString)
forall a. a -> IO a
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) -> IO (acc, ByteString) -> (acc, ByteString)
forall a. IO a -> a
unsafeDupablePerformIO (IO (acc, ByteString) -> (acc, ByteString))
-> IO (acc, ByteString) -> (acc, ByteString)
forall a b. (a -> b) -> a -> b
$ do
ForeignPtr Word8
gp <- Int -> IO (ForeignPtr Word8)
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
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
where
mapAccumR_ :: acc -> Int -> IO acc
mapAccumR_ !acc
s (-1) = acc -> IO acc
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return acc
s
mapAccumR_ !acc
s !Int
n = do
Word8
x <- ForeignPtr Word8 -> Int -> IO Word8
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
ForeignPtr b -> Int -> Word8 -> IO ()
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
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
acc
acc' <- ForeignPtr Word8 -> ForeignPtr Word8 -> IO acc
forall {b}. ForeignPtr Word8 -> ForeignPtr b -> IO acc
go ForeignPtr Word8
a ForeignPtr Word8
gp
(acc, ByteString) -> IO (acc, ByteString)
forall a. a -> IO a
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 (FilePath -> Int -> Int -> Int
checkedAdd FilePath
"scanl" Int
len Int
1) ((ForeignPtr Word8 -> IO ()) -> ByteString)
-> (ForeignPtr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
q -> do
ForeignPtr Word8 -> Word8 -> IO ()
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
Word8
x <- ForeignPtr Word8 -> Int -> IO Word8
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
ForeignPtr b -> Int -> Word8 -> IO ()
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
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
ForeignPtr Word8 -> ForeignPtr Any -> IO ()
forall {b}. ForeignPtr Word8 -> ForeignPtr b -> IO ()
go ForeignPtr Word8
a (ForeignPtr Word8
q ForeignPtr Word8 -> Int -> ForeignPtr Any
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 (FilePath -> Int -> Int -> Int
checkedAdd FilePath
"scanr" Int
len Int
1) ((ForeignPtr Word8 -> IO ()) -> ByteString)
-> (ForeignPtr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
b -> do
ForeignPtr Word8 -> Int -> Word8 -> IO ()
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
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
where
scanr_ :: Word8 -> Int -> IO ()
scanr_ !Word8
z !Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
Word8
x <- ForeignPtr Word8 -> Int -> IO Word8
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
ForeignPtr b -> Int -> Word8 -> IO ()
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
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
ForeignPtr Word8 -> ForeignPtr Word8 -> IO ()
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ByteString
empty
| Bool
otherwise = Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp Int
w ((ForeignPtr Word8 -> IO ()) -> ByteString)
-> (ForeignPtr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
fptr ->
ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
Ptr Word8 -> Word8 -> Int -> IO ()
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 ([ByteString] -> ByteString)
-> (a -> [ByteString]) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> a -> [ByteString]
unfoldChunk Int
32 Int
64
where unfoldChunk :: Int -> Int -> a -> [ByteString]
unfoldChunk Int
n Int
n' a
x =
case Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
unfoldrN Int
n a -> Maybe (Word8, a)
f a
x of
(ByteString
s, Maybe a
Nothing) -> [ByteString
s]
(ByteString
s, Just a
x') -> ByteString
s ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: Int -> Int -> a -> [ByteString]
unfoldChunk Int
n' (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n') a
x'
{-# INLINE unfoldr #-}
unfoldrN :: Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
unfoldrN :: forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
unfoldrN Int
i a -> Maybe (Word8, a)
f a
x0
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = (ByteString
empty, a -> Maybe a
forall a. a -> Maybe a
Just a
x0)
| Bool
otherwise = IO (ByteString, Maybe a) -> (ByteString, Maybe a)
forall a. IO a -> a
unsafeDupablePerformIO (IO (ByteString, Maybe a) -> (ByteString, Maybe a))
-> IO (ByteString, Maybe a) -> (ByteString, Maybe a)
forall a b. (a -> b) -> a -> b
$ Int
-> (ForeignPtr Word8 -> IO (Int, Int, Maybe a))
-> IO (ByteString, Maybe a)
forall a.
Int -> (ForeignPtr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)
createFpAndTrim' Int
i ((ForeignPtr Word8 -> IO (Int, Int, Maybe a))
-> IO (ByteString, Maybe a))
-> (ForeignPtr Word8 -> IO (Int, Int, Maybe a))
-> IO (ByteString, Maybe a)
forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
p -> ForeignPtr Word8 -> a -> Int -> IO (Int, Int, Maybe a)
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 = a -> Int -> IO (a, Int, Maybe a)
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' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i = (a, Int, Maybe a) -> IO (a, Int, Maybe a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
0, Int
n', a -> Maybe a
forall a. a -> Maybe a
Just a
x')
| Bool
otherwise = case a -> Maybe (Word8, a)
f a
x' of
Maybe (Word8, a)
Nothing -> (a, Int, Maybe a) -> IO (a, Int, Maybe a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
0, Int
n', Maybe a
forall a. Maybe a
Nothing)
Just (Word8
w,a
x'') -> do ForeignPtr b -> Int -> Word8 -> IO ()
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'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
{-# INLINE unfoldrN #-}
take :: Int -> ByteString -> ByteString
take :: Int -> ByteString -> ByteString
take Int
n ps :: ByteString
ps@(BS ForeignPtr Word8
x Int
l)
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ByteString
empty
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l = ByteString
ps
| Bool
otherwise = ForeignPtr Word8 -> Int -> 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = ByteString
ps
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ByteString
empty
| Bool
otherwise = ForeignPtr Word8 -> Int -> ByteString
BS (ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
x (Int
len Int -> Int -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ByteString
ps
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l = ByteString
empty
| Bool
otherwise = ForeignPtr Word8 -> Int -> ByteString
BS (ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
x Int
n) (Int
lInt -> Int -> Int
forall 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ByteString
ps
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = ByteString
empty
| Bool
otherwise = ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
x (Int
len Int -> Int -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (ByteString
empty, ByteString
ps)
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l = (ByteString
ps, ByteString
empty)
| Bool
otherwise = (ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
x Int
n, ForeignPtr Word8 -> Int -> ByteString
BS (ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
x Int
n) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n))
{-# INLINE splitAt #-}
takeWhile :: (Word8 -> Bool) -> ByteString -> ByteString
takeWhile :: (Word8 -> Bool) -> ByteString -> ByteString
takeWhile Word8 -> Bool
f ByteString
ps = Int -> ByteString -> ByteString
unsafeTake ((Word8 -> Bool) -> ByteString -> Int
findIndexOrLength (Bool -> Bool
not (Bool -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Bool
f) ByteString
ps) ByteString
ps
{-# INLINE [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 (Bool -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Bool
f) ByteString
ps) ByteString
ps
{-# INLINE takeWhileEnd #-}
dropWhile :: (Word8 -> Bool) -> ByteString -> ByteString
dropWhile :: (Word8 -> Bool) -> ByteString -> ByteString
dropWhile Word8 -> Bool
f ByteString
ps = Int -> ByteString -> ByteString
unsafeDrop ((Word8 -> Bool) -> ByteString -> Int
findIndexOrLength (Bool -> Bool
not (Bool -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Bool
f) ByteString
ps) ByteString
ps
{-# INLINE [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 (Bool -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Bool
f) ByteString
ps) ByteString
ps
{-# INLINE dropWhileEnd #-}
break :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
break :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
break Word8 -> Bool
p ByteString
ps = case (Word8 -> Bool) -> ByteString -> Int
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 (Bool -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
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) =
IO (ByteString, ByteString) -> (ByteString, ByteString)
forall a. IO a -> a
accursedUnutterablePerformIO (IO (ByteString, ByteString) -> (ByteString, ByteString))
-> IO (ByteString, ByteString) -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8
-> (Ptr Word8 -> IO (ByteString, ByteString))
-> IO (ByteString, ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x Ptr Word8 -> IO (ByteString, ByteString)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l = (ByteString, ByteString) -> IO (ByteString, ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
ps, ByteString
empty)
| Bool
otherwise = do Word8
c' <- Ptr b -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
p Int
i
if Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
c'
then (ByteString, ByteString) -> IO (ByteString, ByteString)
forall a. a -> IO a
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
iInt -> Int -> Int
forall 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
not(Bool -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Word8 -> Bool
p) ByteString
ps) ByteString
ps
splitWith :: (Word8 -> Bool) -> ByteString -> [ByteString]
splitWith :: (Word8 -> Bool) -> ByteString -> [ByteString]
splitWith Word8 -> Bool
_ (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' =
IO [ByteString] -> [ByteString]
forall a. IO a -> a
accursedUnutterablePerformIO (IO [ByteString] -> [ByteString])
-> IO [ByteString] -> [ByteString]
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' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len' = [ByteString] -> IO [ByteString]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ForeignPtr Word8 -> Int -> ByteString
BS (ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
fp' Int
off') Int
idx']
| Bool
otherwise = do
Word8
w <- ForeignPtr Word8 -> Int -> IO Word8
forall a. Storable a => ForeignPtr a -> Int -> IO a
peekFpByteOff ForeignPtr Word8
p (Int
off'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
idx')
if Word8 -> Bool
predicate Word8
w
then [ByteString] -> IO [ByteString]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> ByteString
BS (ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
fp' Int
off') Int
idx' ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:
Int -> Int -> ForeignPtr Word8 -> [ByteString]
splitWith0 (Int
off'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
idx'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
len'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
idx'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ForeignPtr Word8
fp')
else Int -> IO [ByteString]
go (Int
idx'Int -> Int -> Int
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 = IO (Ptr Word8) -> Ptr Word8
forall a. IO a -> a
accursedUnutterablePerformIO (IO (Ptr Word8) -> Ptr Word8) -> IO (Ptr Word8) -> Ptr Word8
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO (Ptr Word8)) -> IO (Ptr Word8)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO (Ptr Word8)) -> IO (Ptr Word8))
-> (Ptr Word8 -> IO (Ptr Word8)) -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
memchr (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
n)
Word8
w (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n))
in if Ptr Word8
q Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
forall {b}. Ptr b
nullPtr
then [ForeignPtr Word8 -> Int -> ByteString
BS (ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
x Int
n) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n)]
else let i :: Int
i = Ptr Word8
q Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
x
in ForeignPtr Word8 -> Int -> ByteString
BS (ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
plusForeignPtr ForeignPtr Word8
x Int
n) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n) ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: Int -> [ByteString]
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
{-# INLINE split #-}
group :: ByteString -> [ByteString]
group :: ByteString -> [ByteString]
group ByteString
xs = case ByteString -> Maybe (Word8, ByteString)
uncons ByteString
xs of
Maybe (Word8, ByteString)
Nothing -> []
Just (Word8
h, ByteString
_) -> ByteString
ys ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString]
group ByteString
zs
where
(ByteString
ys, ByteString
zs) = Word8 -> ByteString -> (ByteString, ByteString)
spanByte 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 ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString]
groupBy Word8 -> Word8 -> Bool
k (Int -> ByteString -> ByteString
unsafeDrop Int
n ByteString
xs)
where
n :: Int
n = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Word8 -> Bool) -> ByteString -> Int
findIndexOrLength (Bool -> Bool
not (Bool -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
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
_ [] = 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 ((ForeignPtr Word8 -> IO ()) -> ByteString)
-> (ForeignPtr Word8 -> IO ()) -> ByteString
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
_ [] = () -> IO ()
forall a. a -> IO a
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 ForeignPtr Word8 -> Int -> ForeignPtr b
forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
sepLen
ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp ForeignPtr Word8
forall {b}. ForeignPtr b
destPtr' ForeignPtr Word8
chunkPtr Int
chunkLen
ForeignPtr Word8 -> [ByteString] -> IO ()
go (ForeignPtr Any
forall {b}. ForeignPtr b
destPtr' ForeignPtr Any -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
chunkLen) [ByteString]
chunks
ForeignPtr Word8 -> [ByteString] -> IO ()
go (ForeignPtr Word8
dstPtr0 ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
hLen) [ByteString]
t
where
totalLen :: Int
totalLen = (Int -> ByteString -> Int) -> Int -> [ByteString] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\Int
acc ByteString
chunk -> Int
acc Int -> Int -> Int
+! Int
sepLen Int -> Int -> Int
+! ByteString -> Int
length ByteString
chunk) Int
hLen [ByteString]
t
+! :: Int -> Int -> Int
(+!) = FilePath -> Int -> Int -> Int
checkedAdd FilePath
"intercalate"
{-# INLINABLE intercalate #-}
index :: HasCallStack => ByteString -> Int -> Word8
index :: HasCallStack => ByteString -> Int -> Word8
index ByteString
ps Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = FilePath -> FilePath -> Word8
forall a. HasCallStack => FilePath -> FilePath -> a
moduleError FilePath
"index" (FilePath
"negative index: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n)
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= ByteString -> Int
length ByteString
ps = FilePath -> FilePath -> Word8
forall a. HasCallStack => FilePath -> FilePath -> a
moduleError FilePath
"index" (FilePath
"index too large: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
", length = " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Maybe Word8
forall a. Maybe a
Nothing
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= ByteString -> Int
length ByteString
ps = Maybe Word8
forall a. Maybe a
Nothing
| Bool
otherwise = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
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) = IO (Maybe Int) -> Maybe Int
forall a. IO a -> a
accursedUnutterablePerformIO (IO (Maybe Int) -> Maybe Int) -> IO (Maybe Int) -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int))
-> (Ptr Word8 -> IO (Maybe Int)) -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
Ptr Word8
q <- Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
memchr Ptr Word8
p Word8
c (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
Maybe Int -> IO (Maybe Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> IO (Maybe Int)) -> Maybe Int -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$! if Ptr Word8
q Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
forall {b}. Ptr b
nullPtr then Maybe Int
forall a. Maybe a
Nothing else Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$! Ptr Word8
q Ptr Word8 -> Ptr Word8 -> Int
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 ((Word8 -> Bool) -> ByteString -> Maybe Int)
-> (Word8 -> Word8 -> Bool) -> Word8 -> ByteString -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
(==)
{-# INLINE elemIndexEnd #-}
elemIndices :: Word8 -> ByteString -> [Int]
elemIndices :: Word8 -> ByteString -> [Int]
elemIndices Word8
w (BS ForeignPtr Word8
x Int
l) = Int -> [Int]
loop Int
0
where
loop :: Int -> [Int]
loop !Int
n = IO [Int] -> [Int]
forall a. IO a -> a
accursedUnutterablePerformIO (IO [Int] -> [Int]) -> IO [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO [Int]) -> IO [Int]
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO [Int]) -> IO [Int])
-> (Ptr Word8 -> IO [Int]) -> IO [Int]
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
Ptr Word8
q <- Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
memchr (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
n) Word8
w (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n))
if Ptr Word8
q Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
forall {b}. Ptr b
nullPtr
then [Int] -> IO [Int]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
else let !i :: Int
i = Ptr Word8
q Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
p
in [Int] -> IO [Int]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> IO [Int]) -> [Int] -> IO [Int]
forall a b. (a -> b) -> a -> b
$ Int
i Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int -> [Int]
loop (Int
i Int -> Int -> Int
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) = IO Int -> Int
forall a. IO a -> a
accursedUnutterablePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x ((Ptr Word8 -> IO Int) -> IO Int)
-> (Ptr Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> CSize -> Word8 -> IO CSize
c_count Ptr Word8
p (Int -> CSize
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) = IO (Maybe Int) -> Maybe Int
forall a. IO a -> a
accursedUnutterablePerformIO (IO (Maybe Int) -> Maybe Int) -> IO (Maybe Int) -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> IO (Maybe Int)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l = Maybe Int -> IO (Maybe Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
| Bool
otherwise = do Word8
w <- ForeignPtr Word8 -> IO Word8
forall a. Storable a => ForeignPtr a -> IO a
peekFp (ForeignPtr Word8 -> IO Word8) -> ForeignPtr Word8 -> IO Word8
forall a b. (a -> b) -> a -> b
$ ForeignPtr a
ptr ForeignPtr a -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
n
if Word8 -> Bool
k Word8
w
then Maybe Int -> IO (Maybe Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n)
else Int -> IO (Maybe Int)
go (Int
nInt -> Int -> Int
forall 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) = IO (Maybe Int) -> Maybe Int
forall a. IO a -> a
accursedUnutterablePerformIO (IO (Maybe Int) -> Maybe Int) -> IO (Maybe Int) -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> IO (Maybe Int)
g ForeignPtr Word8
x
where
g :: ForeignPtr Word8 -> IO (Maybe Int)
g !ForeignPtr Word8
ptr = Int -> IO (Maybe Int)
go (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
where
go :: Int -> IO (Maybe Int)
go !Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Maybe Int -> IO (Maybe Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
| Bool
otherwise = do Word8
w <- ForeignPtr Word8 -> Int -> IO Word8
forall a. Storable a => ForeignPtr a -> Int -> IO a
peekFpByteOff ForeignPtr Word8
ptr Int
n
if Word8 -> Bool
k Word8
w
then Maybe Int -> IO (Maybe Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n)
else Int -> IO (Maybe Int)
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
{-# INLINE findIndexEnd #-}
findIndices :: (Word8 -> Bool) -> ByteString -> [Int]
findIndices :: (Word8 -> Bool) -> ByteString -> [Int]
findIndices Word8 -> Bool
p = 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
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i
in Int
j Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int -> ByteString -> [Int]
loop (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> ByteString -> ByteString
unsafeDrop (Int
iInt -> Int -> Int
forall 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
IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString
createFpAndTrim Int
l ((ForeignPtr Word8 -> IO Int) -> IO ByteString)
-> (ForeignPtr Word8 -> IO Int) -> IO ByteString
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 ForeignPtr Word8 -> Int -> ForeignPtr b
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 ForeignPtr Word8 -> ForeignPtr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== ForeignPtr Word8
forall {b}. ForeignPtr b
end = ForeignPtr Word8 -> IO (ForeignPtr Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignPtr Word8
t
| Bool
otherwise = do
Word8
w <- ForeignPtr Word8 -> IO Word8
forall a. Storable a => ForeignPtr a -> IO a
peekFp ForeignPtr Word8
f
if Word8 -> Bool
k Word8
w
then ForeignPtr Word8 -> Word8 -> IO ()
forall a. Storable a => ForeignPtr a -> a -> IO ()
pokeFp ForeignPtr Word8
t Word8
w
IO () -> IO (ForeignPtr Word8) -> IO (ForeignPtr Word8)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ForeignPtr Word8 -> ForeignPtr Word8 -> IO (ForeignPtr Word8)
go (ForeignPtr Word8
f ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
1) (ForeignPtr Word8
t ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
1)
else ForeignPtr Word8 -> ForeignPtr Word8 -> IO (ForeignPtr Word8)
go (ForeignPtr Word8
f ForeignPtr Word8 -> Int -> ForeignPtr Word8
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
Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$! ForeignPtr Word8
t ForeignPtr Word8 -> ForeignPtr Word8 -> Int
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 -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (ByteString
p ByteString -> Int -> Word8
`unsafeIndex` Int
n)
Maybe Int
_ -> Maybe Word8
forall a. Maybe a
Nothing
{-# INLINE find #-}
partition :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
partition :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
partition Word8 -> Bool
f ByteString
s = IO (ByteString, ByteString) -> (ByteString, ByteString)
forall a. IO a -> a
unsafeDupablePerformIO (IO (ByteString, ByteString) -> (ByteString, ByteString))
-> IO (ByteString, ByteString) -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$
do ForeignPtr Word8
p <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
len
let end :: ForeignPtr b
end = ForeignPtr Word8
p ForeignPtr Word8 -> Int -> ForeignPtr b
forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` (Int
len Int -> Int -> Int
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 ForeignPtr Word8
forall {b}. ForeignPtr b
end
ForeignPtr Word8 -> ForeignPtr Word8 -> IO ()
forall {b}. Storable b => ForeignPtr b -> ForeignPtr b -> IO ()
rev ForeignPtr Word8
mid ForeignPtr Word8
forall {b}. ForeignPtr b
end
let i :: Int
i = ForeignPtr Word8
mid ForeignPtr Word8 -> ForeignPtr Word8 -> Int
forall a b. ForeignPtr a -> ForeignPtr b -> Int
`minusForeignPtr` ForeignPtr Word8
p
(ByteString, ByteString) -> IO (ByteString, ByteString)
forall a. a -> IO a
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 ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
i) (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i))
where
len :: Int
len = ByteString -> Int
length ByteString
s
incr :: ForeignPtr a -> ForeignPtr b
incr = (ForeignPtr a -> Int -> ForeignPtr b
forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
1)
decr :: ForeignPtr a -> ForeignPtr b
decr = (ForeignPtr a -> Int -> ForeignPtr b
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len = ForeignPtr Word8 -> IO (ForeignPtr Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignPtr Word8
p1
| Word8 -> Bool
f Word8
w = do ForeignPtr Word8 -> Word8 -> IO ()
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (ForeignPtr Word8 -> ForeignPtr Word8
forall {a} {b}. ForeignPtr a -> ForeignPtr b
incr ForeignPtr Word8
p1) ForeignPtr Word8
p2
| Bool
otherwise = do ForeignPtr Word8 -> Word8 -> IO ()
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ForeignPtr Word8
p1 (ForeignPtr Word8 -> ForeignPtr Word8
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 ForeignPtr b -> ForeignPtr b -> Bool
forall a. Ord a => a -> a -> Bool
>= ForeignPtr b
p2 = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do b
a <- ForeignPtr b -> IO b
forall a. Storable a => ForeignPtr a -> IO a
peekFp ForeignPtr b
p1
b
b <- ForeignPtr b -> IO b
forall a. Storable a => ForeignPtr a -> IO a
peekFp ForeignPtr b
p2
ForeignPtr b -> b -> IO ()
forall a. Storable a => ForeignPtr a -> a -> IO ()
pokeFp ForeignPtr b
p1 b
b
ForeignPtr b -> b -> IO ()
forall a. Storable a => ForeignPtr a -> a -> IO ()
pokeFp ForeignPtr b
p2 b
a
ForeignPtr b -> ForeignPtr b -> IO ()
rev (ForeignPtr b -> ForeignPtr b
forall {a} {b}. ForeignPtr a -> ForeignPtr b
incr ForeignPtr b
p1) (ForeignPtr b -> ForeignPtr b
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Bool
True
| Int
l2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l1 = Bool
False
| Bool
otherwise = IO Bool -> Bool
forall a. IO a -> a
accursedUnutterablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x1 ((Ptr Word8 -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p1 ->
ForeignPtr Word8 -> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x2 ((Ptr Word8 -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p2 -> do
CInt
i <- Ptr Word8 -> Ptr Word8 -> Int -> IO CInt
memcmp Ptr Word8
p1 Ptr Word8
p2 (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l1)
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$! CInt
i CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
stripPrefix :: ByteString -> ByteString -> Maybe ByteString
stripPrefix :: ByteString -> ByteString -> Maybe ByteString
stripPrefix bs1 :: ByteString
bs1@(BS ForeignPtr Word8
_ Int
l1) ByteString
bs2
| ByteString
bs1 ByteString -> ByteString -> Bool
`isPrefixOf` ByteString
bs2 = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Int -> ByteString -> ByteString
unsafeDrop Int
l1 ByteString
bs2)
| Bool
otherwise = Maybe ByteString
forall a. Maybe a
Nothing
isSuffixOf :: ByteString -> ByteString -> Bool
isSuffixOf :: ByteString -> ByteString -> Bool
isSuffixOf (BS ForeignPtr Word8
x1 Int
l1) (BS ForeignPtr Word8
x2 Int
l2)
| Int
l1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Bool
True
| Int
l2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l1 = Bool
False
| Bool
otherwise = IO Bool -> Bool
forall a. IO a -> a
accursedUnutterablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x1 ((Ptr Word8 -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p1 ->
ForeignPtr Word8 -> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
x2 ((Ptr Word8 -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p2 -> do
CInt
i <- Ptr Word8 -> Ptr Word8 -> Int -> IO CInt
memcmp Ptr Word8
p1 (Ptr Word8
p2 Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
l2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l1)) (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l1)
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$! CInt
i CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
stripSuffix :: ByteString -> ByteString -> Maybe ByteString
stripSuffix :: ByteString -> ByteString -> Maybe ByteString
stripSuffix bs1 :: ByteString
bs1@(BS ForeignPtr Word8
_ Int
l1) bs2 :: ByteString
bs2@(BS ForeignPtr Word8
_ Int
l2)
| ByteString
bs1 ByteString -> ByteString -> Bool
`isSuffixOf` ByteString
bs2 = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Int -> ByteString -> ByteString
unsafeTake (Int
l2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l1) ByteString
bs2)
| Bool
otherwise = Maybe ByteString
forall a. Maybe a
Nothing
isInfixOf :: ByteString -> ByteString -> Bool
isInfixOf :: ByteString -> ByteString -> Bool
isInfixOf ByteString
p ByteString
s = ByteString -> Bool
null ByteString
p Bool -> Bool -> Bool
|| Bool -> Bool
not (ByteString -> Bool
null (ByteString -> Bool) -> ByteString -> Bool
forall a b. (a -> b) -> a -> b
$ (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString) -> ByteString
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) = IO Bool -> Bool
forall a. IO a -> a
accursedUnutterablePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
ptr ((Ptr Word8 -> IO Bool) -> IO Bool)
-> (Ptr Word8 -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
CInt
i <- if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1000000
then Ptr Word8 -> CSize -> IO CInt
cIsValidUtf8 Ptr Word8
p (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
else Ptr Word8 -> CSize -> IO CInt
cIsValidUtf8Safe Ptr Word8
p (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ CInt
i CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Word -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Word
0 :: Word)
then ByteString -> (ByteString, ByteString)
shift
else ByteString -> (ByteString, ByteString)
karpRabin
where
unsafeSplitAt :: Int -> ByteString -> (ByteString, ByteString)
unsafeSplitAt Int
i ByteString
s = (Int -> ByteString -> ByteString
unsafeTake Int
i ByteString
s, Int -> ByteString -> ByteString
unsafeDrop Int
i ByteString
s)
lp :: Int
lp = ByteString -> Int
length ByteString
pat
karpRabin :: ByteString -> (ByteString, ByteString)
karpRabin :: ByteString -> (ByteString, ByteString)
karpRabin ByteString
src
| ByteString -> Int
length ByteString
src Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lp = (ByteString
src,ByteString
empty)
| Bool
otherwise = Word32 -> Int -> (ByteString, ByteString)
search (ByteString -> Word32
rollingHash (ByteString -> Word32) -> ByteString -> Word32
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
unsafeTake Int
lp ByteString
src) Int
lp
where
k :: Word32
k = Word32
2891336453 :: Word32
rollingHash :: ByteString -> Word32
rollingHash = (Word32 -> Word8 -> Word32) -> Word32 -> ByteString -> Word32
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
foldl' (\Word32
h Word8
b -> Word32
h Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
k Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) Word32
0
hp :: Word32
hp = ByteString -> Word32
rollingHash ByteString
pat
m :: Word32
m = Word32
k Word32 -> Int -> Word32
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
lp
get :: Int -> Word32
get = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> (Int -> Word8) -> Int -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int -> Word8
unsafeIndex ByteString
src
search :: Word32 -> Int -> (ByteString, ByteString)
search !Word32
hs !Int
i
| Word32
hp Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
hs Bool -> Bool -> Bool
&& ByteString
pat ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> ByteString -> ByteString
unsafeTake Int
lp ByteString
b = (ByteString, ByteString)
u
| ByteString -> Int
length ByteString
src Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i = (ByteString
src,ByteString
empty)
| Bool
otherwise = Word32 -> Int -> (ByteString, ByteString)
search Word32
hs' (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
where
u :: (ByteString, ByteString)
u@(ByteString
_, ByteString
b) = Int -> ByteString -> (ByteString, ByteString)
unsafeSplitAt (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lp) ByteString
src
hs' :: Word32
hs' = Word32
hs Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
k Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+
Int -> Word32
get Int
i Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
-
Word32
m Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Int -> Word32
get (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lp)
{-# INLINE karpRabin #-}
shift :: ByteString -> (ByteString, ByteString)
shift :: ByteString -> (ByteString, ByteString)
shift !ByteString
src
| ByteString -> Int
length ByteString
src Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lp = (ByteString
src,ByteString
empty)
| Bool
otherwise = Word -> Int -> (ByteString, ByteString)
search (ByteString -> Word
intoWord (ByteString -> Word) -> ByteString -> Word
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
unsafeTake Int
lp ByteString
src) Int
lp
where
intoWord :: ByteString -> Word
intoWord :: ByteString -> Word
intoWord = (Word -> Word8 -> Word) -> Word -> ByteString -> Word
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
foldl' (\Word
w Word8
b -> (Word
w Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) Word
0
wp :: Word
wp = ByteString -> Word
intoWord ByteString
pat
mask :: Word
mask = (Word
1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
lp)) Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1
search :: Word -> Int -> (ByteString, ByteString)
search !Word
w !Int
i
| Word
w Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
wp = Int -> ByteString -> (ByteString, ByteString)
unsafeSplitAt (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lp) ByteString
src
| ByteString -> Int
length ByteString
src Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i = (ByteString
src, ByteString
empty)
| Bool
otherwise = Word -> Int -> (ByteString, ByteString)
search Word
w' (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
where
b :: Word
b = Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
unsafeIndex ByteString
src Int
i)
w' :: Word
w' = Word
mask Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. ((Word
w Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word
b)
{-# INLINE shift #-}
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) (Word8, Word8) -> [(Word8, Word8)] -> [(Word8, Word8)]
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 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
forall a. (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
zipWith Word8 -> Word8 -> a
f ByteString
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) = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
Int -> (ForeignPtr Word8 -> IO ()) -> IO ByteString
createFp Int
len ((ForeignPtr Word8 -> IO ()) -> IO ByteString)
-> (ForeignPtr Word8 -> IO ()) -> IO ByteString
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
Word8
x <- ForeignPtr Word8 -> Int -> IO Word8
forall a. Storable a => ForeignPtr a -> Int -> IO a
peekFpByteOff ForeignPtr Word8
p1 Int
n
Word8
y <- ForeignPtr Word8 -> Int -> IO Word8
forall a. Storable a => ForeignPtr a -> Int -> IO a
peekFpByteOff ForeignPtr Word8
p2 Int
n
ForeignPtr Word8 -> Int -> Word8 -> IO ()
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
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ForeignPtr Word8
r
len :: Int
len = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
l Int
m
{-# INLINE packZipWith #-}
unzip :: [(Word8,Word8)] -> (ByteString,ByteString)
unzip :: [(Word8, Word8)] -> (ByteString, ByteString)
unzip [(Word8, Word8)]
ls = ([Word8] -> ByteString
pack (((Word8, Word8) -> Word8) -> [(Word8, Word8)] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
P.map (Word8, Word8) -> Word8
forall a b. (a, b) -> a
fst [(Word8, Word8)]
ls), [Word8] -> ByteString
pack (((Word8, Word8) -> Word8) -> [(Word8, Word8)] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
P.map (Word8, Word8) -> Word8
forall a b. (a, b) -> b
snd [(Word8, Word8)]
ls))
{-# INLINE unzip #-}
inits :: ByteString -> [ByteString]
inits :: ByteString -> [ByteString]
inits ByteString
bs = NonEmpty ByteString -> [ByteString]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty ByteString -> [ByteString])
-> NonEmpty ByteString -> [ByteString]
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 ByteString -> [ByteString] -> NonEmpty ByteString
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 = NonEmpty ByteString -> [ByteString]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty ByteString -> [ByteString])
-> NonEmpty ByteString -> [ByteString]
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 ByteString -> [ByteString] -> NonEmpty ByteString
forall a. a -> [a] -> NonEmpty a
:| []
| Bool
otherwise = ByteString
p ByteString -> [ByteString] -> NonEmpty ByteString
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
20 = Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp Int
l ((ForeignPtr Word8 -> IO ()) -> ByteString)
-> (ForeignPtr Word8 -> IO ()) -> ByteString
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
ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
destFP ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
dest -> Ptr Word8 -> CSize -> IO ()
c_sort Ptr Word8
dest (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
| Bool
otherwise = Int -> (ForeignPtr Word8 -> IO ()) -> ByteString
unsafeCreateFp Int
l ((ForeignPtr Word8 -> IO ()) -> ByteString)
-> (ForeignPtr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
p -> Int -> (Ptr Int -> IO ()) -> IO ()
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
256 ((Ptr Int -> IO ()) -> IO ()) -> (Ptr Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Int
arr -> do
Ptr Any -> Word8 -> Int -> IO ()
forall a. Ptr a -> Word8 -> Int -> IO ()
fillBytes (Ptr Int -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr Int
arr) Word8
0 (Int
256 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall a. Storable a => a -> Int
sizeOf (Int
forall a. HasCallStack => a
undefined :: Int))
ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
input (\Ptr Word8
x -> Ptr 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
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
go Int
i !Ptr b
ptr = do Int
n <- Ptr Int -> Int -> IO Int
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Int
arr Int
i
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Ptr b -> Word8 -> Int -> IO ()
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Ptr b
ptr Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
p (Int -> Ptr Word8 -> IO ()
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do Int
k <- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> IO Word8 -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Word8
str Int
i
Int
x <- Ptr Int -> Int -> IO Int
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Int
counts Int
k
Ptr Int -> Int -> Int -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Int
counts Int
k (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Int -> IO ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
useAsCString :: ByteString -> (CString -> IO a) -> IO a
useAsCString :: forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString (BS ForeignPtr Word8
fp Int
l) CString -> IO a
action =
Int -> (Ptr Word8 -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ((Ptr Word8 -> IO a) -> IO a) -> (Ptr Word8 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
buf -> do
ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
buf Ptr Word8
p Int
l
Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
buf Int
l (Word8
0::Word8)
CString -> IO a
action (Ptr Word8 -> CString
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
buf)
useAsCStringLen :: ByteString -> (CStringLen -> IO a) -> IO a
useAsCStringLen :: forall a. ByteString -> (CStringLen -> IO a) -> IO a
useAsCStringLen p :: ByteString
p@(BS ForeignPtr Word8
_ Int
l) CStringLen -> IO a
f = ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString ByteString
p ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
cstr -> CStringLen -> IO a
f (CString
cstr,Int
l)
packCString :: CString -> IO ByteString
packCString :: CString -> IO ByteString
packCString CString
cstr = do
CSize
len <- CString -> IO CSize
c_strlen CString
cstr
CStringLen -> IO ByteString
packCStringLen (CString
cstr, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
len)
packCStringLen :: CStringLen -> IO ByteString
packCStringLen :: CStringLen -> IO ByteString
packCStringLen (CString
cstr, Int
len) | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 = Int -> (ForeignPtr Word8 -> IO ()) -> IO ByteString
createFp Int
len ((ForeignPtr Word8 -> IO ()) -> IO ByteString)
-> (ForeignPtr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
fp ->
ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
p (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
cstr) Int
len
packCStringLen (CString
_, Int
len) =
FilePath -> FilePath -> IO ByteString
forall a. HasCallStack => FilePath -> FilePath -> IO a
moduleErrorIO FilePath
"packCStringLen" (FilePath
"negative length: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
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 ((ForeignPtr Word8 -> IO ()) -> ByteString)
-> (ForeignPtr Word8 -> IO ()) -> ByteString
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
{-# DEPRECATED getLine
"Deprecated since @bytestring-0.12@. Use 'Data.ByteString.Char8.getLine' instead. (Functions that rely on ASCII encodings belong in \"Data.ByteString.Char8\")"
#-}
hGetLine :: Handle -> IO ByteString
hGetLine :: Handle -> IO ByteString
hGetLine Handle
h =
FilePath -> Handle -> (Handle__ -> IO ByteString) -> IO ByteString
forall a. FilePath -> Handle -> (Handle__ -> IO a) -> IO a
wantReadableHandle_ FilePath
"Data.ByteString.hGetLine" Handle
h ((Handle__ -> IO ByteString) -> IO ByteString)
-> (Handle__ -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$
\ h_ :: Handle__
h_@Handle__{IORef (Buffer Word8)
haByteBuffer :: IORef (Buffer Word8)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haByteBuffer} -> do
Handle__ -> IO ()
flushCharReadBuffer Handle__
h_
Buffer Word8
buf <- IORef (Buffer Word8) -> IO (Buffer Word8)
forall a. IORef a -> IO a
readIORef IORef (Buffer Word8)
haByteBuffer
if Buffer Word8 -> Bool
forall e. Buffer e -> Bool
isEmptyBuffer Buffer Word8
buf
then Handle__ -> Buffer Word8 -> Int -> [ByteString] -> IO ByteString
fill Handle__
h_ Buffer Word8
buf Int
0 []
else Handle__ -> Buffer Word8 -> Int -> [ByteString] -> IO ByteString
haveBuf Handle__
h_ Buffer Word8
buf Int
0 []
where
fill :: Handle__ -> Buffer Word8 -> Int -> [ByteString] -> IO ByteString
fill h_ :: Handle__
h_@Handle__{IORef (Buffer Word8)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haByteBuffer :: IORef (Buffer Word8)
haByteBuffer,dev
haDevice :: dev
haDevice :: ()
haDevice} Buffer Word8
buf !Int
len [ByteString]
xss = do
(Int
r,Buffer Word8
buf') <- dev -> Buffer Word8 -> IO (Int, Buffer Word8)
forall dev.
BufferedIO dev =>
dev -> Buffer Word8 -> IO (Int, Buffer Word8)
Buffered.fillReadBuffer dev
haDevice Buffer Word8
buf
if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then do IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
buf{ bufR=0, bufL=0 }
if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then Int -> [ByteString] -> IO ByteString
mkBigPS Int
len [ByteString]
xss
else IO ByteString
forall a. IO a
ioe_EOF
else Handle__ -> Buffer Word8 -> Int -> [ByteString] -> IO ByteString
haveBuf Handle__
h_ Buffer Word8
buf' Int
len [ByteString]
xss
haveBuf :: Handle__ -> Buffer Word8 -> Int -> [ByteString] -> IO ByteString
haveBuf h_ :: Handle__
h_@Handle__{IORef (Buffer Word8)
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haByteBuffer :: 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r
ByteString
xs <- ForeignPtr Word8 -> Int -> Int -> IO ByteString
mkPS ForeignPtr Word8
raw Int
r Int
off
if Int
off Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
w
then do if Int
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
then IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
buf{ bufL=0, bufR=0 }
else IORef (Buffer Word8) -> Buffer Word8 -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Buffer Word8)
haByteBuffer Buffer Word8
buf{ bufL = off + 1 }
Int -> [ByteString] -> IO ByteString
mkBigPS Int
new_len (ByteString
xsByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
xss)
else Handle__ -> Buffer Word8 -> Int -> [ByteString] -> IO ByteString
fill Handle__
h_ Buffer Word8
buf{ bufL=0, bufR=0 } Int
new_len (ByteString
xsByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
xss)
findEOL :: Int -> Int -> ForeignPtr Word8 -> IO Int
findEOL Int
r Int
w ForeignPtr Word8
raw
| Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
w = Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
w
| Bool
otherwise = do
Word8
c <- ForeignPtr Word8 -> Int -> IO Word8
readWord8Buf ForeignPtr Word8
raw Int
r
if Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
'\n')
then Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
r
else Int -> Int -> ForeignPtr Word8 -> IO Int
findEOL (Int
rInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
w ForeignPtr Word8
raw
{-# DEPRECATED hGetLine
"Deprecated since @bytestring-0.12@. Use 'Data.ByteString.Char8.hGetLine' instead. (Functions that rely on ASCII encodings belong in \"Data.ByteString.Char8\")"
#-}
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 ((ForeignPtr Word8 -> IO ()) -> IO ByteString)
-> (ForeignPtr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
fp -> ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()
memcpyFp ForeignPtr Word8
fp (ForeignPtr Word8
buf ForeignPtr Word8 -> Int -> ForeignPtr Word8
forall a b. ForeignPtr a -> Int -> ForeignPtr b
`plusForeignPtr` Int
start) Int
len
where
len :: Int
len = Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start
mkBigPS :: Int -> [ByteString] -> IO ByteString
mkBigPS :: Int -> [ByteString] -> IO ByteString
mkBigPS Int
_ [ByteString
ps] = ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
ps
mkBigPS Int
_ [ByteString]
pss = ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! [ByteString] -> ByteString
concat ([ByteString] -> [ByteString]
forall a. [a] -> [a]
P.reverse [ByteString]
pss)
hPut :: Handle -> ByteString -> IO ()
hPut :: Handle -> ByteString -> IO ()
hPut Handle
_ (BS ForeignPtr Word8
_ Int
0) = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
hPut Handle
h (BS ForeignPtr Word8
ps Int
l) = ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
ps ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p-> Handle -> Ptr Word8 -> Int -> IO ()
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 <- ForeignPtr Word8 -> (Ptr Word8 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
ps ((Ptr Word8 -> IO Int) -> IO Int)
-> (Ptr Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p-> Handle -> Ptr Word8 -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hPutBufNonBlocking Handle
h Ptr Word8
p Int
l
ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! Int -> ByteString -> ByteString
drop Int
bytesWritten ByteString
bs
hPutStr :: Handle -> ByteString -> IO ()
hPutStr :: Handle -> ByteString -> IO ()
hPutStr = Handle -> ByteString -> IO ()
hPut
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString
createFpAndTrim Int
i ((ForeignPtr Word8 -> IO Int) -> IO ByteString)
-> (ForeignPtr Word8 -> IO Int) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
fp ->
ForeignPtr Word8 -> (Ptr Word8 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO Int) -> IO Int)
-> (Ptr Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Handle -> Ptr Word8 -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
h Ptr Word8
p Int
i
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
empty
| Bool
otherwise = Handle -> FilePath -> Int -> IO ByteString
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString
createFpAndTrim Int
i ((ForeignPtr Word8 -> IO Int) -> IO ByteString)
-> (ForeignPtr Word8 -> IO Int) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
fp ->
ForeignPtr Word8 -> (Ptr Word8 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO Int) -> IO Int)
-> (Ptr Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Handle -> Ptr Word8 -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBufNonBlocking Handle
h Ptr Word8
p Int
i
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
empty
| Bool
otherwise = Handle -> FilePath -> Int -> IO ByteString
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString
createFpAndTrim Int
i ((ForeignPtr Word8 -> IO Int) -> IO ByteString)
-> (ForeignPtr Word8 -> IO Int) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ForeignPtr Word8
fp ->
ForeignPtr Word8 -> (Ptr Word8 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO Int) -> IO Int)
-> (Ptr Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Handle -> Ptr Word8 -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBufSome Handle
hh Ptr Word8
p Int
i
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
empty
| Bool
otherwise = Handle -> FilePath -> Int -> IO ByteString
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 =
IOException -> IO a
forall a. IOException -> IO a
ioError (IOErrorType
-> FilePath -> Maybe Handle -> Maybe FilePath -> IOException
mkIOError IOErrorType
illegalOperationErrorType FilePath
msg (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
handle) Maybe FilePath
forall a. Maybe a
Nothing)
where
msg :: FilePath
msg = FilePath
fn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": illegal ByteString size " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> Int -> FilePath -> FilePath
forall a. Show a => Int -> a -> FilePath -> FilePath
showsPrec Int
9 Int
sz []
hGetContents :: Handle -> IO ByteString
hGetContents :: Handle -> IO ByteString
hGetContents Handle
hnd = do
ByteString
bs <- Handle -> Int -> Int -> IO ByteString
hGetContentsSizeHint Handle
hnd Int
1024 Int
2048
IO ByteString -> IO () -> IO ByteString
forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
hClose Handle
hnd
if ByteString -> Int
length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
900
then ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString
copy ByteString
bs
else ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
hGetContentsSizeHint :: Handle
-> Int
-> Int
-> IO ByteString
hGetContentsSizeHint :: Handle -> Int -> Int -> IO ByteString
hGetContentsSizeHint Handle
hnd =
[ByteString] -> Int -> Int -> IO ByteString
readChunks []
where
readChunks :: [ByteString] -> Int -> Int -> IO ByteString
readChunks [ByteString]
chunks Int
sz Int
sz' = do
ForeignPtr Word8
fp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocByteString Int
sz
Int
readcount <- ForeignPtr Word8 -> (Ptr Word8 -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
unsafeWithForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO Int) -> IO Int)
-> (Ptr Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
buf -> Handle -> Ptr Word8 -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
hnd Ptr Word8
buf Int
sz
let chunk :: ByteString
chunk = ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
fp Int
readcount
if Int
readcount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sz Bool -> Bool -> Bool
&& Int
sz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! [ByteString] -> ByteString
concat ([ByteString] -> [ByteString]
forall a. [a] -> [a]
P.reverse (ByteString
chunk ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
chunks))
else [ByteString] -> Int -> Int -> IO ByteString
readChunks (ByteString
chunk ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
chunks) Int
sz' ((Int
szInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
sz') Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` Int
32752)
getContents :: IO ByteString
getContents :: IO ByteString
getContents = Handle -> IO ByteString
hGetContents Handle
stdin
interact :: (ByteString -> ByteString) -> IO ()
interact :: (ByteString -> ByteString) -> IO ()
interact ByteString -> ByteString
transformer = ByteString -> IO ()
putStr (ByteString -> IO ())
-> (ByteString -> ByteString) -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
transformer (ByteString -> IO ()) -> IO ByteString -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO ByteString
getContents
readFile :: FilePath -> IO ByteString
readFile :: FilePath -> IO ByteString
readFile FilePath
f =
FilePath -> IOMode -> (Handle -> IO ByteString) -> IO ByteString
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
f IOMode
ReadMode ((Handle -> IO ByteString) -> IO ByteString)
-> (Handle -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
Integer
filesz <- IO Integer -> (IOException -> IO Integer) -> IO Integer
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 = (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
filesz Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
0) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
Handle -> Int -> Int -> IO ByteString
hGetContentsSizeHint Handle
h Int
readsz (Int
readsz Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
255)
where
useZeroIfNotRegularFile :: IOException -> IO Integer
useZeroIfNotRegularFile :: IOException -> IO Integer
useZeroIfNotRegularFile IOException
_ = Integer -> IO Integer
forall a. a -> IO a
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 = FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
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 = FilePath -> FilePath -> a
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 = FilePath -> a
forall a. HasCallStack => FilePath -> a
error (FilePath -> FilePath -> FilePath
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 = IOException -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO a)
-> (FilePath -> IOException) -> FilePath -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IOException
userError (FilePath -> IO a) -> FilePath -> IO a
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
moduleErrorMsg FilePath
fun FilePath
msg
{-# NOINLINE moduleErrorIO #-}
moduleErrorMsg :: String -> String -> String
moduleErrorMsg :: FilePath -> FilePath -> FilePath
moduleErrorMsg FilePath
fun FilePath
msg = FilePath
"Data.ByteString." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
fun FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Char
':'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Char
' 'Char -> FilePath -> FilePath
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