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