{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__
{-# LANGUAGE MagicHash, UnboxedTuples,
NamedFieldPuns, BangPatterns #-}
#endif
{-# 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,
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)
import Data.ByteString.Internal
import Data.ByteString.Unsafe
import qualified Data.List as List
import Data.Word (Word8)
import Data.Maybe (isJust, listToMaybe)
#ifndef __NHC__
import Control.Exception (finally, bracket, assert, throwIO)
#else
import Control.Exception (bracket, finally)
#endif
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,openBinaryFile
,IOMode(..))
import System.IO.Error (mkIOError, illegalOperationErrorType)
#if !(MIN_VERSION_base(4,8,0))
import Data.Monoid (Monoid(..))
#endif
#if !defined(__GLASGOW_HASKELL__)
import System.IO.Unsafe
import qualified System.Environment
import qualified System.IO (hGetLine)
import System.IO (hIsEOF)
#endif
#if defined(__GLASGOW_HASKELL__)
import System.IO (hGetBufNonBlocking, hPutBufNonBlocking)
#if MIN_VERSION_base(4,3,0)
import System.IO (hGetBufSome)
#else
import System.IO (hWaitForInput, hIsEOF)
#endif
#if __GLASGOW_HASKELL__ >= 611
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)
#else
import System.IO.Error (isEOFError)
import GHC.IOBase
import GHC.Handle
#endif
import GHC.Prim (Word#)
import GHC.Base (build)
import GHC.Word hiding (Word8)
#endif
#ifdef __NHC__
import System.IO (Handle)
#define assert assertS "__FILE__ : __LINE__"
assertS :: String -> Bool -> a -> a
assertS _ True = id
assertS s False = error ("assertion failed at "++s)
hWaitForInput :: Handle -> Int -> IO ()
hWaitForInput _ _ = return ()
#endif
#ifndef __GLASGOW_HASKELL__
unsafeDupablePerformIO = unsafePerformIO
#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]
#if !defined(__GLASGOW_HASKELL__)
unpack = unpackBytes
#else
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
#-}
#endif
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)
#if __GLASGOW_HASKELL__
{-# INLINE [1] break #-}
#endif
{-# RULES
"ByteString specialise break (x==)" forall x.
break ((==) x) = breakByte x
"ByteString specialise break (==x)" forall x.
break (==x) = breakByte x
#-}
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
#if __GLASGOW_HASKELL__
{-# INLINE [1] span #-}
#endif
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 #-}
{-# RULES
"ByteString specialise span (x==)" forall x.
span ((==) x) = spanByte x
"ByteString specialise span (==x)" forall x.
span (==x) = spanByte x
#-}
spanEnd :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
spanEnd p ps = splitAt (findFromEndUntil (not.p) ps) ps
splitWith :: (Word8 -> Bool) -> ByteString -> [ByteString]
#if defined(__GLASGOW_HASKELL__)
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 #-}
#else
splitWith _ (PS _ _ 0) = []
splitWith p ps = loop p ps
where
loop !q !qs = if null rest then [chunk]
else chunk : loop q (unsafeTail rest)
where (chunk,rest) = break q qs
#endif
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 p bs = (filter p bs, filter (not . p) bs)
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
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
isInfixOf :: ByteString -> ByteString -> Bool
isInfixOf p s = isJust (findSubstring p s)
breakSubstring :: ByteString
-> ByteString
-> (ByteString,ByteString)
breakSubstring pat src = search 0 src
where
search !n !s
| null s = (src,empty)
| pat `isPrefixOf` s = (take n src,s)
| otherwise = search (n+1) (unsafeTail s)
findSubstring :: ByteString
-> ByteString
-> Maybe Int
findSubstring f i = listToMaybe (findSubstrings f i)
{-# DEPRECATED findSubstring "findSubstring is deprecated in favour of breakSubstring." #-}
findSubstrings :: ByteString
-> ByteString
-> [Int]
findSubstrings pat str
| null pat = [0 .. length str]
| otherwise = search 0 str
where
search !n !s
| null s = []
| pat `isPrefixOf` s = n : search (n+1) (unsafeTail s)
| otherwise = search (n+1) (unsafeTail s)
{-# 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 = do
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
#if !defined(__GLASGOW_HASKELL__)
hGetLine h = System.IO.hGetLine h >>= return . pack . P.map c2w
#elif __GLASGOW_HASKELL__ >= 611
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 do
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 -> do
copyBytes p (pbuf `plusPtr` start) len
where
len = end - start
#else
hGetLine h = wantReadableHandle "Data.ByteString.hGetLine" h $ \ handle_ -> do
case haBufferMode handle_ of
NoBuffering -> error "no buffering"
_other -> hGetLineBuffered handle_
where
hGetLineBuffered handle_ = do
let ref = haBuffer handle_
buf <- readIORef ref
hGetLineBufferedLoop handle_ ref buf 0 []
hGetLineBufferedLoop handle_ ref
buf@Buffer{ bufRPtr=r, bufWPtr=w, bufBuf=raw } !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 ref buf{ bufRPtr=0, bufWPtr=0 }
else writeIORef ref buf{ bufRPtr = off + 1 }
mkBigPS new_len (xs:xss)
else do
maybe_buf <- maybeFillReadBuffer (haFD handle_) True (haIsStream handle_)
buf{ bufWPtr=0, bufRPtr=0 }
case maybe_buf of
Nothing -> do
writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
if new_len > 0
then mkBigPS new_len (xs:xss)
else ioe_EOF
Just new_buf ->
hGetLineBufferedLoop handle_ ref new_buf new_len (xs:xss)
findEOL r w raw
| r == w = return w
| otherwise = do
(c,r') <- readCharFromBuffer raw r
if c == '\n'
then return r
else findEOL r' w raw
maybeFillReadBuffer fd is_line is_stream buf = catch
(do buf' <- fillReadBuffer fd is_line is_stream buf
return (Just buf'))
(\e -> if isEOFError e then return Nothing else ioError e)
mkPS :: RawBuffer -> Int -> Int -> IO ByteString
mkPS buf start end =
let len = end - start
in create len $ \p -> do
memcpy_ptr_baoff p buf (fromIntegral start) (fromIntegral len)
return ()
memcpy_ptr_baoff dst src src_off sz = memcpy dst (src+src_off) sz
#endif
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
#if defined(__GLASGOW_HASKELL__)
hPutNonBlocking h bs@(PS ps s l) = do
bytesWritten <- withForeignPtr ps $ \p-> hPutBufNonBlocking h (p `plusPtr` s) l
return $! drop bytesWritten bs
#else
hPutNonBlocking h bs = hPut h bs >> return empty
#endif
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
#if defined(__GLASGOW_HASKELL__)
hGetNonBlocking h i
| i > 0 = createAndTrim i $ \p -> hGetBufNonBlocking h p i
| i == 0 = return empty
| otherwise = illegalBufferSize h "hGetNonBlocking" i
#else
hGetNonBlocking = hGet
#endif
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 =
bracket (openBinaryFile f ReadMode) hClose $ \h -> do
filesz <- hFileSize h
let readsz = (fromIntegral filesz `max` 0) + 1
hGetContentsSizeHint h readsz (readsz `max` 255)
writeFile :: FilePath -> ByteString -> IO ()
writeFile f txt = bracket (openBinaryFile f WriteMode) hClose
(\h -> hPut h txt)
appendFile :: FilePath -> ByteString -> IO ()
appendFile f txt = bracket (openBinaryFile f AppendMode) hClose
(\h -> hPut h txt)
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 =
#if MIN_VERSION_base(4,0,0)
throwIO . userError $ moduleErrorMsg fun msg
#else
throwIO . IOException . userError $ moduleErrorMsg fun msg
#endif
{-# 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) =
if null ps then 0
else if f (unsafeLast ps) then l
else findFromEndUntil f (PS x s (l-1))