{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# OPTIONS_HADDOCK prune #-}
#if __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Trustworthy #-}
#endif
module Data.ByteString (
ByteString,
empty,
singleton,
pack,
unpack,
fromStrict,
toStrict,
cons,
snoc,
append,
head,
uncons,
unsnoc,
last,
tail,
init,
null,
length,
map,
reverse,
intersperse,
intercalate,
transpose,
foldl,
foldl',
foldl1,
foldl1',
foldr,
foldr',
foldr1,
foldr1',
concat,
concatMap,
any,
all,
maximum,
minimum,
scanl,
scanl1,
scanr,
scanr1,
mapAccumL,
mapAccumR,
replicate,
unfoldr,
unfoldrN,
take,
drop,
splitAt,
takeWhile,
takeWhileEnd,
dropWhile,
dropWhileEnd,
span,
spanEnd,
break,
breakEnd,
group,
groupBy,
inits,
tails,
stripPrefix,
stripSuffix,
split,
splitWith,
isPrefixOf,
isSuffixOf,
isInfixOf,
breakSubstring,
elem,
notElem,
find,
filter,
partition,
index,
indexMaybe,
(!?),
elemIndex,
elemIndices,
elemIndexEnd,
findIndex,
findIndices,
findIndexEnd,
count,
zip,
zipWith,
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,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.Lazy.Internal (fromStrict, toStrict)
import Data.ByteString.Unsafe
import qualified Data.List as List
import Data.Word (Word8)
import Control.Exception (IOException, catch, finally, assert, throwIO)
import Control.Monad (when)
import Foreign.C.String (CString, CStringLen)
import Foreign.C.Types (CSize)
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.Base (build)
import GHC.Word hiding (Word8)
#if !(MIN_VERSION_base(4,7,0))
finiteBitSize = bitSize
#endif
empty :: ByteString
empty = BS nullForeignPtr 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 (BS _ l) = assert (l >= 0) $ l <= 0
{-# INLINE null #-}
length :: ByteString -> Int
length (BS _ l) = assert (l >= 0) l
{-# INLINE length #-}
infixr 5 `cons`
infixl 5 `snoc`
cons :: Word8 -> ByteString -> ByteString
cons c (BS x l) = unsafeCreate (l+1) $ \p -> withForeignPtr x $ \f -> do
poke p c
memcpy (p `plusPtr` 1) f (fromIntegral l)
{-# INLINE cons #-}
snoc :: ByteString -> Word8 -> ByteString
snoc (BS x l) c = unsafeCreate (l+1) $ \p -> withForeignPtr x $ \f -> do
memcpy p f (fromIntegral l)
poke (p `plusPtr` l) c
{-# INLINE snoc #-}
head :: ByteString -> Word8
head (BS x l)
| l <= 0 = errorEmptyList "head"
| otherwise = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> peek p
{-# INLINE head #-}
tail :: ByteString -> ByteString
tail (BS p l)
| l <= 0 = errorEmptyList "tail"
| otherwise = BS (plusForeignPtr p 1) (l-1)
{-# INLINE tail #-}
uncons :: ByteString -> Maybe (Word8, ByteString)
uncons (BS x l)
| l <= 0 = Nothing
| otherwise = Just (accursedUnutterablePerformIO $ withForeignPtr x
$ \p -> peek p,
BS (plusForeignPtr x 1) (l-1))
{-# INLINE uncons #-}
last :: ByteString -> Word8
last ps@(BS x l)
| null ps = errorEmptyList "last"
| otherwise = accursedUnutterablePerformIO $
withForeignPtr x $ \p -> peekByteOff p (l-1)
{-# INLINE last #-}
init :: ByteString -> ByteString
init ps@(BS p l)
| null ps = errorEmptyList "init"
| otherwise = BS p (l-1)
{-# INLINE init #-}
unsnoc :: ByteString -> Maybe (ByteString, Word8)
unsnoc (BS x l)
| l <= 0 = Nothing
| otherwise = Just (BS x (l-1),
accursedUnutterablePerformIO $
withForeignPtr x $ \p -> peekByteOff p (l-1))
{-# INLINE unsnoc #-}
append :: ByteString -> ByteString -> ByteString
append = mappend
{-# INLINE append #-}
map :: (Word8 -> Word8) -> ByteString -> ByteString
map f (BS fp len) = unsafeDupablePerformIO $ withForeignPtr fp $ \a ->
create len $ map_ 0 a
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 (BS x l) = unsafeCreate l $ \p -> withForeignPtr x $ \f ->
c_reverse p f (fromIntegral l)
intersperse :: Word8 -> ByteString -> ByteString
intersperse c ps@(BS x l)
| length ps < 2 = ps
| otherwise = unsafeCreate (2*l-1) $ \p -> withForeignPtr x $ \f ->
c_intersperse p f (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 (BS fp len) = go (end `plusPtr` len)
where
end = (unsafeForeignPtrToPtr fp) `plusPtr` (-1)
go !p | p == end = z
| otherwise = let !x = accursedUnutterablePerformIO $ do
x' <- peek p
touchForeignPtr fp
return x'
in f (go (p `plusPtr` (-1))) x
{-# INLINE foldl #-}
foldl' :: (a -> Word8 -> a) -> a -> ByteString -> a
foldl' f v (BS fp len) =
accursedUnutterablePerformIO $ withForeignPtr fp g
where
g ptr = go v ptr
where
end = ptr `plusPtr` len
go !z !p | p == end = return z
| otherwise = do x <- peek p
go (f z x) (p `plusPtr` 1)
{-# INLINE foldl' #-}
foldr :: (Word8 -> a -> a) -> a -> ByteString -> a
foldr k z (BS fp len) = go ptr
where
ptr = unsafeForeignPtrToPtr fp
end = ptr `plusPtr` len
go !p | p == end = z
| otherwise = let !x = accursedUnutterablePerformIO $ do
x' <- peek p
touchForeignPtr fp
return x'
in k x (go (p `plusPtr` 1))
{-# INLINE foldr #-}
foldr' :: (Word8 -> a -> a) -> a -> ByteString -> a
foldr' k v (BS fp len) =
accursedUnutterablePerformIO $ withForeignPtr fp g
where
g ptr = go v (end `plusPtr` len)
where
end = ptr `plusPtr` (-1)
go !z !p | p == end = return z
| otherwise = do x <- peek p
go (k x z) (p `plusPtr` (-1))
{-# 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 _ (BS _ 0) = False
any f (BS x len) = accursedUnutterablePerformIO $ withForeignPtr x g
where
g ptr = go ptr
where
end = ptr `plusPtr` len
go !p | p == end = return False
| otherwise = do c <- peek p
if f c then return True
else go (p `plusPtr` 1)
{-# INLINE [1] any #-}
#if MIN_VERSION_base(4,9,0)
{-# RULES
"ByteString specialise any (x ==)" forall x.
any (x `eqWord8`) = anyByte x
"ByteString specialise any (== x)" forall x.
any (`eqWord8` x) = anyByte x
#-}
#else
{-# RULES
"ByteString specialise any (x ==)" forall x.
any (x ==) = anyByte x
"ByteString specialise any (== x)" forall x.
any (== x) = anyByte x
#-}
#endif
anyByte :: Word8 -> ByteString -> Bool
anyByte c (BS x l) = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> do
q <- memchr p c (fromIntegral l)
return $! q /= nullPtr
{-# INLINE anyByte #-}
all :: (Word8 -> Bool) -> ByteString -> Bool
all _ (BS _ 0) = True
all f (BS x len) = accursedUnutterablePerformIO $ withForeignPtr x g
where
g ptr = go ptr
where
end = ptr `plusPtr` len
go !p | p == end = return True
| otherwise = do c <- peek p
if f c
then go (p `plusPtr` 1)
else return False
{-# INLINE [1] all #-}
#if MIN_VERSION_base(4,9,0)
{-# 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
#-}
#else
{-# RULES
"ByteString specialise all (x /=)" forall x.
all (x /=) = not . anyByte x
"ByteString specialise all (/= x)" forall x.
all (/= x) = not . anyByte x
#-}
#endif
maximum :: ByteString -> Word8
maximum xs@(BS x l)
| null xs = errorEmptyList "maximum"
| otherwise = accursedUnutterablePerformIO $ withForeignPtr x $ \p ->
c_maximum p (fromIntegral l)
{-# INLINE maximum #-}
minimum :: ByteString -> Word8
minimum xs@(BS x l)
| null xs = errorEmptyList "minimum"
| otherwise = accursedUnutterablePerformIO $ withForeignPtr x $ \p ->
c_minimum p (fromIntegral l)
{-# INLINE minimum #-}
mapAccumL :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)
mapAccumL f acc (BS fp len) = unsafeDupablePerformIO $ withForeignPtr fp $ \a -> do
gp <- mallocByteString len
acc' <- withForeignPtr gp (go a)
return (acc', BS gp len)
where
go src dst = mapAccumL_ acc 0
where
mapAccumL_ !s !n
| n >= len = return s
| otherwise = do
x <- peekByteOff src n
let (s', y) = f s x
pokeByteOff dst n y
mapAccumL_ s' (n+1)
{-# INLINE mapAccumL #-}
mapAccumR :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)
mapAccumR f acc (BS fp len) = unsafeDupablePerformIO $ withForeignPtr fp $ \a -> do
gp <- mallocByteString len
acc' <- withForeignPtr gp (go a)
return $! (acc', BS gp len)
where
go src dst = mapAccumR_ acc (len-1)
where
mapAccumR_ !s (-1) = return s
mapAccumR_ !s !n = do
x <- peekByteOff src n
let (s', y) = f s x
pokeByteOff dst n y
mapAccumR_ s' (n-1)
{-# INLINE mapAccumR #-}
scanl
:: (Word8 -> Word8 -> Word8)
-> Word8
-> ByteString
-> ByteString
scanl f v (BS fp len) = unsafeDupablePerformIO $ withForeignPtr fp $ \a ->
create (len+1) $ \q -> do
poke q v
go a (q `plusPtr` 1)
where
go src dst = scanl_ v 0
where
scanl_ !z !n
| n >= len = return ()
| otherwise = do
x <- peekByteOff src n
let z' = f z x
pokeByteOff dst n z'
scanl_ z' (n+1)
{-# 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 (BS fp len) = unsafeDupablePerformIO $ withForeignPtr fp $ \a ->
create (len+1) $ \q -> do
poke (q `plusPtr` len) v
go a q
where
go p q = scanr_ v (len-1)
where
scanr_ !z !n
| n < 0 = return ()
| otherwise = do
x <- peekByteOff p n
let z' = f x z
pokeByteOff q n z'
scanr_ z' (n-1)
{-# 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 ()
{-# INLINE replicate #-}
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@(BS x l)
| n <= 0 = empty
| n >= l = ps
| otherwise = BS x n
{-# INLINE take #-}
drop :: Int -> ByteString -> ByteString
drop n ps@(BS x l)
| n <= 0 = ps
| n >= l = empty
| otherwise = BS (plusForeignPtr x n) (l-n)
{-# INLINE drop #-}
splitAt :: Int -> ByteString -> (ByteString, ByteString)
splitAt n ps@(BS x l)
| n <= 0 = (empty, ps)
| n >= l = (ps, empty)
| otherwise = (BS x n, BS (plusForeignPtr x n) (l-n))
{-# INLINE splitAt #-}
takeWhile :: (Word8 -> Bool) -> ByteString -> ByteString
takeWhile f ps = unsafeTake (findIndexOrEnd (not . f) ps) ps
{-# INLINE [1] takeWhile #-}
#if MIN_VERSION_base(4,9,0)
{-# 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
#-}
#else
{-# RULES
"ByteString specialise takeWhile (x /=)" forall x.
takeWhile (x /=) = fst . breakByte x
"ByteString specialise takeWhile (/= x)" forall x.
takeWhile (/= x) = fst . breakByte x
"ByteString specialise takeWhile (x ==)" forall x.
takeWhile (x ==) = fst . spanByte x
"ByteString specialise takeWhile (== x)" forall x.
takeWhile (== x) = fst . spanByte x
#-}
#endif
takeWhileEnd :: (Word8 -> Bool) -> ByteString -> ByteString
takeWhileEnd f ps = unsafeDrop (findFromEndUntil (not . f) ps) ps
{-# INLINE takeWhileEnd #-}
dropWhile :: (Word8 -> Bool) -> ByteString -> ByteString
dropWhile f ps = unsafeDrop (findIndexOrEnd (not . f) ps) ps
{-# INLINE [1] dropWhile #-}
#if MIN_VERSION_base(4,9,0)
{-# 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
#-}
#else
{-# RULES
"ByteString specialise dropWhile (x /=)" forall x.
dropWhile (x /=) = snd . breakByte x
"ByteString specialise dropWhile (/= x)" forall x.
dropWhile (/= x) = snd . breakByte x
"ByteString specialise dropWhile (x ==)" forall x.
dropWhile (x ==) = snd . spanByte x
"ByteString specialise dropWhile (== x)" forall x.
dropWhile (== x) = snd . spanByte x
#-}
#endif
dropWhileEnd :: (Word8 -> Bool) -> ByteString -> ByteString
dropWhileEnd f ps = unsafeTake (findFromEndUntil (not . f) ps) ps
{-# INLINE dropWhileEnd #-}
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 #-}
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@(BS x l) =
accursedUnutterablePerformIO $ withForeignPtr x g
where
g p = go 0
where
go !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 (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 _ (BS _ 0) = []
splitWith predicate (BS fp len) = splitWith0 0 len fp
where splitWith0 !off' !len' !fp' =
accursedUnutterablePerformIO $
withForeignPtr fp $ \p ->
splitLoop p 0 off' len' fp'
splitLoop :: Ptr Word8
-> Int -> Int -> Int
-> ForeignPtr Word8
-> IO [ByteString]
splitLoop p idx2 off' len' fp' = go idx2
where
go idx'
| idx' >= len' = return [BS (plusForeignPtr fp' off') idx']
| otherwise = do
w <- peekElemOff p (off'+idx')
if predicate w
then return (BS (plusForeignPtr fp' off') idx' :
splitWith0 (off'+idx'+1) (len'-idx'-1) fp')
else go (idx'+1)
{-# INLINE splitWith #-}
split :: Word8 -> ByteString -> [ByteString]
split _ (BS _ 0) = []
split w (BS x l) = loop 0
where
loop !n =
let q = accursedUnutterablePerformIO $ withForeignPtr x $ \p ->
memchr (p `plusPtr` n)
w (fromIntegral (l-n))
in if q == nullPtr
then [BS (plusForeignPtr x n) (l-n)]
else let i = accursedUnutterablePerformIO $ withForeignPtr x $ \p ->
return (q `minusPtr` p)
in BS (plusForeignPtr x 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@(BS ffp l) g@(BS fgp m) = unsafeCreate len $ \ptr ->
withForeignPtr ffp $ \fp ->
withForeignPtr fgp $ \gp -> do
memcpy ptr fp (fromIntegral l)
poke (ptr `plusPtr` l) c
memcpy (ptr `plusPtr` (l + 1)) gp (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 #-}
indexMaybe :: ByteString -> Int -> Maybe Word8
indexMaybe ps n
| n < 0 = Nothing
| n >= length ps = Nothing
| otherwise = Just $! ps `unsafeIndex` n
{-# INLINE indexMaybe #-}
(!?) :: ByteString -> Int -> Maybe Word8
(!?) = indexMaybe
{-# INLINE (!?) #-}
elemIndex :: Word8 -> ByteString -> Maybe Int
elemIndex c (BS x l) = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> do
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 = findIndexEnd . (==)
{-# INLINE elemIndexEnd #-}
elemIndices :: Word8 -> ByteString -> [Int]
elemIndices w (BS x l) = loop 0
where
loop !n = accursedUnutterablePerformIO $ withForeignPtr x $ \p -> do
q <- memchr (p `plusPtr` n) w (fromIntegral (l - n))
if q == nullPtr
then return []
else let !i = q `minusPtr` p
in return $ i : loop (i + 1)
{-# INLINE elemIndices #-}
count :: Word8 -> ByteString -> Int
count w (BS x m) = accursedUnutterablePerformIO $ withForeignPtr x $ \p ->
fmap fromIntegral $ c_count p (fromIntegral m) w
{-# INLINE count #-}
findIndex :: (Word8 -> Bool) -> ByteString -> Maybe Int
findIndex k (BS x l) = accursedUnutterablePerformIO $ withForeignPtr x $ \f -> go f 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 [1] findIndex #-}
findIndexEnd :: (Word8 -> Bool) -> ByteString -> Maybe Int
findIndexEnd k (BS x l) = accursedUnutterablePerformIO $ withForeignPtr x $ \ f -> go f (l-1)
where
go !ptr !n | n < 0 = return Nothing
| otherwise = do w <- peekByteOff ptr n
if k w
then return (Just n)
else go ptr (n-1)
{-# INLINE findIndexEnd #-}
findIndices :: (Word8 -> Bool) -> ByteString -> [Int]
findIndices p ps = loop 0 ps
where
loop !n !qs = case findIndex p qs of
Just !i ->
let !j = n+i
in j : loop (j+1) (unsafeDrop (i+1) qs)
Nothing -> []
{-# INLINE [1] findIndices #-}
#if MIN_VERSION_base(4,9,0)
{-# 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
#-}
#else
{-# RULES
"ByteString specialise findIndex (x ==)" forall x. findIndex (x==) = elemIndex x
"ByteString specialise findIndex (== x)" forall x. findIndex (==x) = elemIndex x
"ByteString specialise findIndices (x ==)" forall x. findIndices (x==) = elemIndices x
"ByteString specialise findIndices (== x)" forall x. findIndices (==x) = elemIndices x
#-}
#endif
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@(BS x l)
| null ps = ps
| otherwise = unsafePerformIO $ createAndTrim l $ \p -> withForeignPtr x $ \f -> do
t <- go' f p
return $! t `minusPtr` p
where
go' pf pt = go pf pt
where
end = pf `plusPtr` l
go !f !t | f == end = return t
| otherwise = do
w <- peek f
if k w
then poke t w >> go (f `plusPtr` 1) (t `plusPtr` 1)
else go (f `plusPtr` 1) t
{-# 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 (BS fp' i,
BS (plusForeignPtr 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 (BS x1 l1) (BS x2 l2)
| l1 == 0 = True
| l2 < l1 = False
| otherwise = accursedUnutterablePerformIO $ withForeignPtr x1 $ \p1 ->
withForeignPtr x2 $ \p2 -> do
i <- memcmp p1 p2 (fromIntegral l1)
return $! i == 0
stripPrefix :: ByteString -> ByteString -> Maybe ByteString
stripPrefix bs1@(BS _ l1) bs2
| bs1 `isPrefixOf` bs2 = Just (unsafeDrop l1 bs2)
| otherwise = Nothing
isSuffixOf :: ByteString -> ByteString -> Bool
isSuffixOf (BS x1 l1) (BS x2 l2)
| l1 == 0 = True
| l2 < l1 = False
| otherwise = accursedUnutterablePerformIO $ withForeignPtr x1 $ \p1 ->
withForeignPtr x2 $ \p2 -> do
i <- memcmp p1 (p2 `plusPtr` (l2 - l1)) (fromIntegral l1)
return $! i == 0
stripSuffix :: ByteString -> ByteString -> Maybe ByteString
stripSuffix bs1@(BS _ l1) bs2@(BS _ l2)
| bs1 `isSuffixOf` bs2 = Just (unsafeTake (l2 - l1) bs2)
| otherwise = Nothing
isInfixOf :: ByteString -> ByteString -> Bool
isInfixOf p s = null p || not (null $ snd $ breakSubstring 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 #-}
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 (BS fp l) (BS fq m) = unsafeDupablePerformIO $
withForeignPtr fp $ \a ->
withForeignPtr fq $ \b ->
create len $ go a b
where
go p1 p2 = zipWith_ 0
where
zipWith_ :: Int -> Ptr Word8 -> IO ()
zipWith_ !n !r
| n >= len = return ()
| otherwise = do
x <- peekByteOff p1 n
y <- peekByteOff p2 n
pokeByteOff r n (f x y)
zipWith_ (n+1) 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 (BS x l) = [BS x n | n <- [0..l]]
tails :: ByteString -> [ByteString]
tails p | null p = [empty]
| otherwise = p : tails (unsafeTail p)
sort :: ByteString -> ByteString
sort (BS input l)
| l <= 20 = unsafeCreate l $ \ptr -> withForeignPtr input $ \inp -> do
memcpy ptr inp (fromIntegral l)
c_sort ptr (fromIntegral l)
| otherwise = unsafeCreate l $ \p -> allocaArray 256 $ \arr -> do
_ <- memset (castPtr arr) 0 (256 * fromIntegral (sizeOf (undefined :: CSize)))
withForeignPtr input (\x -> countOccurrences arr x 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 (BS fp l) action =
allocaBytes (l+1) $ \buf ->
withForeignPtr fp $ \p -> do
memcpy buf p (fromIntegral l)
pokeByteOff buf l (0::Word8)
action (castPtr buf)
useAsCStringLen :: ByteString -> (CStringLen -> IO a) -> IO a
useAsCStringLen p@(BS _ 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 (BS x l) = unsafeCreate l $ \p -> withForeignPtr x $ \f ->
memcpy p f (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 _ (BS _ 0) = return ()
hPut h (BS ps l) = withForeignPtr ps $ \p-> hPutBuf h p l
hPutNonBlocking :: Handle -> ByteString -> IO ByteString
hPutNonBlocking h bs@(BS ps l) = do
bytesWritten <- withForeignPtr ps $ \p-> hPutBufNonBlocking h p l
return $! drop bytesWritten bs
hPutStr :: Handle -> ByteString -> IO ()
hPutStr = hPut
putStr :: ByteString -> IO ()
putStr = hPut stdout
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 = BS fp 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 (BS x l) =
accursedUnutterablePerformIO $ withForeignPtr x g
where
g ptr = go 0
where
go !n | n >= l = return l
| otherwise = do w <- peek $ ptr `plusPtr` n
if k w
then return n
else go (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@(BS x l)
| null ps = 0
| f (unsafeLast ps) = l
| otherwise = findFromEndUntil f (BS x (l - 1))