{-# OPTIONS_GHC -cpp -fglasgow-exts -fno-warn-orphans #-}
--
-- Module : ByteString
-- Copyright : (c) The University of Glasgow 2001,
-- (c) David Roundy 2003-2005,
-- (c) Simon Marlow 2005
-- (c) Don Stewart 2005-2006
-- (c) Bjorn Bringert 2006
--
-- Array fusion code:
-- (c) 2001,2002 Manuel M T Chakravarty & Gabriele Keller
-- (c) 2006 Manuel M T Chakravarty & Roman Leshchinskiy
--
-- License : BSD-style
--
-- Maintainer : dons@cse.unsw.edu.au
-- Stability : experimental
-- Portability : portable, requires ffi and cpp
-- Tested with : GHC 6.4.1 and Hugs March 2005
--
--
-- | A time and space-efficient implementation of byte vectors using
-- packed Word8 arrays, suitable for high performance use, both in terms
-- of large data quantities, or high speed requirements. Byte vectors
-- are encoded as strict 'Word8' arrays of bytes, held in a 'ForeignPtr',
-- and can be passed between C and Haskell with little effort.
--
-- This module is intended to be imported @qualified@, to avoid name
-- clashes with "Prelude" functions. eg.
--
-- > import qualified Data.ByteString as B
--
-- Original GHC implementation by Bryan O\'Sullivan. Rewritten to use
-- UArray by Simon Marlow. Rewritten to support slices and use
-- ForeignPtr by David Roundy. Polished and extended by Don Stewart.
--
module Data.ByteString (
-- * The @ByteString@ type
ByteString, -- abstract, instances: Eq, Ord, Show, Read, Data, Typeable, Monoid
-- * Introducing and eliminating 'ByteString's
empty, -- :: ByteString
singleton, -- :: Word8 -> ByteString
pack, -- :: [Word8] -> ByteString
unpack, -- :: ByteString -> [Word8]
packWith, -- :: (a -> Word8) -> [a] -> ByteString
unpackWith, -- :: (Word8 -> a) -> ByteString -> [a]
-- * Basic interface
cons, -- :: Word8 -> ByteString -> ByteString
snoc, -- :: ByteString -> Word8 -> ByteString
append, -- :: ByteString -> ByteString -> ByteString
head, -- :: ByteString -> Word8
last, -- :: ByteString -> Word8
tail, -- :: ByteString -> ByteString
init, -- :: ByteString -> ByteString
null, -- :: ByteString -> Bool
length, -- :: ByteString -> Int
-- * Transformating ByteStrings
map, -- :: (Word8 -> Word8) -> ByteString -> ByteString
map', -- :: (Word8 -> Word8) -> ByteString -> ByteString
reverse, -- :: ByteString -> ByteString
intersperse, -- :: Word8 -> ByteString -> ByteString
transpose, -- :: [ByteString] -> [ByteString]
-- * Reducing 'ByteString's (folds)
foldl, -- :: (a -> Word8 -> a) -> a -> ByteString -> a
foldl', -- :: (a -> Word8 -> a) -> a -> ByteString -> a
foldl1, -- :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldl1', -- :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldr, -- :: (Word8 -> a -> a) -> a -> ByteString -> a
foldr1, -- :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
-- ** Special folds
concat, -- :: [ByteString] -> ByteString
concatMap, -- :: (Word8 -> ByteString) -> ByteString -> ByteString
any, -- :: (Word8 -> Bool) -> ByteString -> Bool
all, -- :: (Word8 -> Bool) -> ByteString -> Bool
maximum, -- :: ByteString -> Word8
minimum, -- :: ByteString -> Word8
-- * Building ByteStrings
-- ** Scans
scanl, -- :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
scanl1, -- :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
scanr, -- :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
scanr1, -- :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
-- ** Accumulating maps
mapAccumL, -- :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)
mapAccumR, -- :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)
mapIndexed, -- :: (Int -> Word8 -> Word8) -> ByteString -> ByteString
-- ** Unfolding ByteStrings
replicate, -- :: Int -> Word8 -> ByteString
unfoldr, -- :: (a -> Maybe (Word8, a)) -> a -> ByteString
unfoldrN, -- :: Int -> (a -> Maybe (Word8, a)) -> a -> ByteString
-- * Substrings
-- ** Breaking strings
take, -- :: Int -> ByteString -> ByteString
drop, -- :: Int -> ByteString -> ByteString
splitAt, -- :: Int -> ByteString -> (ByteString, ByteString)
takeWhile, -- :: (Word8 -> Bool) -> ByteString -> ByteString
dropWhile, -- :: (Word8 -> Bool) -> ByteString -> ByteString
span, -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
spanEnd, -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
break, -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
breakEnd, -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
group, -- :: ByteString -> [ByteString]
groupBy, -- :: (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString]
inits, -- :: ByteString -> [ByteString]
tails, -- :: ByteString -> [ByteString]
-- ** Breaking and dropping on specific bytes
breakByte, -- :: Word8 -> ByteString -> (ByteString, ByteString)
spanByte, -- :: Word8 -> ByteString -> (ByteString, ByteString)
-- ** Breaking into many substrings
split, -- :: Word8 -> ByteString -> [ByteString]
splitWith, -- :: (Word8 -> Bool) -> ByteString -> [ByteString]
tokens, -- :: (Word8 -> Bool) -> ByteString -> [ByteString]
-- ** Joining strings
join, -- :: ByteString -> [ByteString] -> ByteString
joinWithByte, -- :: Word8 -> ByteString -> ByteString -> ByteString
-- * Predicates
isPrefixOf, -- :: ByteString -> ByteString -> Bool
isSuffixOf, -- :: ByteString -> ByteString -> Bool
-- ** Search for arbitrary substrings
isSubstringOf, -- :: ByteString -> ByteString -> Bool
findSubstring, -- :: ByteString -> ByteString -> Maybe Int
findSubstrings, -- :: ByteString -> ByteString -> [Int]
-- * Searching ByteStrings
-- ** Searching by equality
-- | These functions use memchr(3) to efficiently search the ByteString
elem, -- :: Word8 -> ByteString -> Bool
notElem, -- :: Word8 -> ByteString -> Bool
filterByte, -- :: Word8 -> ByteString -> ByteString
filterNotByte, -- :: Word8 -> ByteString -> ByteString
-- ** Searching with a predicate
find, -- :: (Word8 -> Bool) -> ByteString -> Maybe Word8
filter, -- :: (Word8 -> Bool) -> ByteString -> ByteString
filter', -- :: (Word8 -> Bool) -> ByteString -> ByteString
-- partition -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
-- * Indexing ByteStrings
index, -- :: ByteString -> Int -> Word8
elemIndex, -- :: Word8 -> ByteString -> Maybe Int
elemIndices, -- :: Word8 -> ByteString -> [Int]
elemIndexEnd, -- :: Word8 -> ByteString -> Maybe Int
findIndex, -- :: (Word8 -> Bool) -> ByteString -> Maybe Int
findIndices, -- :: (Word8 -> Bool) -> ByteString -> [Int]
count, -- :: Word8 -> ByteString -> Int
findIndexOrEnd, -- :: (Word8 -> Bool) -> ByteString -> Int
-- * Zipping and unzipping ByteStrings
zip, -- :: ByteString -> ByteString -> [(Word8,Word8)]
zipWith, -- :: (Word8 -> Word8 -> c) -> ByteString -> ByteString -> [c]
zipWith',
unzip, -- :: [(Word8,Word8)] -> (ByteString,ByteString)
-- * Ordered ByteStrings
sort, -- :: ByteString -> ByteString
-- * Low level CString conversions
-- ** Packing CStrings and pointers
packCString, -- :: CString -> ByteString
packCStringLen, -- :: CString -> ByteString
packMallocCString, -- :: CString -> ByteString
-- ** Using ByteStrings as CStrings
useAsCString, -- :: ByteString -> (CString -> IO a) -> IO a
useAsCStringLen, -- :: ByteString -> (CStringLen -> IO a) -> IO a
-- ** Copying ByteStrings
-- | These functions perform memcpy(3) operations
copy, -- :: ByteString -> ByteString
copyCString, -- :: CString -> IO ByteString
copyCStringLen, -- :: CStringLen -> IO ByteString
-- * I\/O with 'ByteString's
-- ** Standard input and output
getLine, -- :: IO ByteString
getContents, -- :: IO ByteString
putStr, -- :: ByteString -> IO ()
putStrLn, -- :: ByteString -> IO ()
interact, -- :: (ByteString -> ByteString) -> IO ()
-- ** Files
readFile, -- :: FilePath -> IO ByteString
writeFile, -- :: FilePath -> ByteString -> IO ()
appendFile, -- :: FilePath -> ByteString -> IO ()
-- mmapFile, -- :: FilePath -> IO ByteString
-- ** I\/O with Handles
getArgs, -- :: IO [ByteString]
hGetLine, -- :: Handle -> IO ByteString
hGetLines, -- :: Handle -> IO [ByteString]
hGetContents, -- :: Handle -> IO ByteString
hGet, -- :: Handle -> Int -> IO ByteString
hGetNonBlocking, -- :: Handle -> Int -> IO ByteString
hPut, -- :: Handle -> ByteString -> IO ()
hPutStr, -- :: Handle -> ByteString -> IO ()
hPutStrLn, -- :: Handle -> ByteString -> IO ()
-- * Fusion utilities
#if defined(__GLASGOW_HASKELL__)
unpackList, -- eek, otherwise it gets thrown away by the simplifier
#endif
lengthU, maximumU, minimumU
) 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.Base
import Data.ByteString.Fusion
import qualified Data.List as List
import Data.Word (Word8)
import Data.Maybe (listToMaybe)
import Data.Array (listArray)
import qualified Data.Array as Array ((!))
-- Control.Exception.bracket not available in yhc or nhc
import Control.Exception (bracket, assert)
import Control.Monad (when)
import Foreign.C.String (CString, CStringLen)
import Foreign.C.Types (CSize)
import Foreign.ForeignPtr
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable (Storable(..))
-- hGetBuf and hPutBuf not available in yhc or nhc
import System.IO (stdin,stdout,hClose,hFileSize,hIsEOF
,hGetBuf,hPutBuf,Handle,IOMode(..),openBinaryFile)
import Data.Monoid (Monoid, mempty, mappend, mconcat)
#if !defined(__GLASGOW_HASKELL__)
import System.IO.Unsafe
import qualified System.Environment
import qualified System.IO (hGetLine)
#endif
#if defined(__GLASGOW_HASKELL__)
import System.IO (hGetBufNonBlocking)
import System.IO.Error (isEOFError)
import Foreign.Marshal (alloca)
import qualified Foreign.Concurrent as FC (newForeignPtr)
import GHC.Handle
import GHC.Prim (Word#, (+#), writeWord8OffAddr#)
import GHC.Base (build)
import GHC.Word hiding (Word8)
import GHC.Ptr (Ptr(..))
import GHC.ST (ST(..))
import GHC.IOBase
#endif
-- -----------------------------------------------------------------------------
--
-- Useful macros, until we have bang patterns
--
#define STRICT1(f) f a | a `seq` False = undefined
#define STRICT2(f) f a b | a `seq` b `seq` False = undefined
#define STRICT3(f) f a b c | a `seq` b `seq` c `seq` False = undefined
#define STRICT4(f) f a b c d | a `seq` b `seq` c `seq` d `seq` False = undefined
#define STRICT5(f) f a b c d e | a `seq` b `seq` c `seq` d `seq` e `seq` False = undefined
-- -----------------------------------------------------------------------------
instance Eq ByteString
where (==) = eq
instance Ord ByteString
where compare = compareBytes
instance Show ByteString where
showsPrec p ps r = showsPrec p (unpackWith w2c ps) r
instance Read ByteString where
readsPrec p str = [ (packWith c2w x, y) | (x, y) <- readsPrec p str ]
instance Monoid ByteString where
mempty = empty
mappend = append
mconcat = concat
{-
instance Arbitrary PackedString where
arbitrary = P.pack `fmap` arbitrary
coarbitrary s = coarbitrary (P.unpack s)
-}
-- | /O(n)/ Equality on the 'ByteString' type.
eq :: ByteString -> ByteString -> Bool
eq a@(PS p s l) b@(PS p' s' l')
| l /= l' = False -- short cut on length
| p == p' && s == s' = True -- short cut for the same string
| otherwise = compareBytes a b == EQ
{-# INLINE eq #-}
-- | /O(n)/ 'compareBytes' provides an 'Ordering' for 'ByteStrings' supporting slices.
compareBytes :: ByteString -> ByteString -> Ordering
compareBytes (PS x1 s1 l1) (PS x2 s2 l2)
| l1 == 0 && l2 == 0 = EQ -- short cut for empty strings
| x1 == x2 && s1 == s2 && l1 == l2 = EQ -- short cut for the same string
| otherwise = inlinePerformIO $
withForeignPtr x1 $ \p1 ->
withForeignPtr x2 $ \p2 -> do
i <- memcmp (p1 `plusPtr` s1) (p2 `plusPtr` s2) (fromIntegral $ min l1 l2)
return $! case i `compare` 0 of
EQ -> l1 `compare` l2
x -> x
{-# INLINE compareBytes #-}
{-
--
-- About 4x slower over 32M
--
compareBytes :: ByteString -> ByteString -> Ordering
compareBytes (PS fp1 off1 len1) (PS fp2 off2 len2) = inlinePerformIO $
withForeignPtr fp1 $ \p1 ->
withForeignPtr fp2 $ \p2 ->
cmp (p1 `plusPtr` off1)
(p2 `plusPtr` off2) 0 len1 len2
cmp :: Ptr Word8 -> Ptr Word8 -> Int -> Int -> Int-> IO Ordering
STRICT5(cmp)
cmp p1 p2 n len1 len2
| n == len1 = if n == len2 then return EQ else return LT
| n == len2 = return GT
| otherwise = do
(a :: Word8) <- peekByteOff p1 n
(b :: Word8) <- peekByteOff p2 n
case a `compare` b of
EQ -> cmp p1 p2 (n+1) len1 len2
LT -> return LT
GT -> return GT
{-# INLINE compareBytes #-}
-}
-- -----------------------------------------------------------------------------
-- Introducing and eliminating 'ByteString's
-- | /O(1)/ The empty 'ByteString'
empty :: ByteString
empty = unsafeCreate 0 $ const $ return ()
{-# NOINLINE empty #-}
-- | /O(1)/ Convert a 'Word8' into a 'ByteString'
singleton :: Word8 -> ByteString
singleton c = unsafeCreate 1 $ \p -> poke p c
{-# INLINE singleton #-}
--
-- XXX The unsafePerformIO is critical!
--
-- Otherwise:
--
-- singleton 255 `compare` singleton 127
--
-- is compiled to:
--
-- case mallocByteString 2 of
-- ForeignPtr f internals ->
-- case writeWord8OffAddr# f 0 255 of _ ->
-- case writeWord8OffAddr# f 0 127 of _ ->
-- case eqAddr# f f of
-- False -> case compare (GHC.Prim.plusAddr# f 0)
-- (GHC.Prim.plusAddr# f 0)
--
--
-- | /O(n)/ Convert a '[Word8]' into a 'ByteString'.
--
-- For applications with large numbers of string literals, pack can be a
-- bottleneck. In such cases, consider using packAddress (GHC only).
pack :: [Word8] -> ByteString
#if !defined(__GLASGOW_HASKELL__)
pack str = unsafeCreate (P.length str) $ \p -> go p str
where
go _ [] = return ()
go p (x:xs) = poke p x >> go (p `plusPtr` 1) xs -- less space than pokeElemOff
#else /* hack away */
pack str = unsafeCreate (P.length str) $ \(Ptr p) -> stToIO (go p 0# str)
where
go _ _ [] = return ()
go p i (W8# c:cs) = writeByte p i c >> go p (i +# 1#) cs
writeByte p i c = ST $ \s# ->
case writeWord8OffAddr# p i c s# of s2# -> (# s2#, () #)
#endif
-- | /O(n)/ Converts a 'ByteString' to a '[Word8]'.
unpack :: ByteString -> [Word8]
#if !defined(__GLASGOW_HASKELL__)
unpack (PS _ _ 0) = []
unpack (PS ps s l) = inlinePerformIO $ withForeignPtr ps $ \p ->
go (p `plusPtr` s) (l - 1) []
where
STRICT3(go)
go p 0 acc = peek p >>= \e -> return (e : acc)
go p n acc = peekByteOff p n >>= \e -> go p (n-1) (e : acc)
{-# INLINE unpack #-}
#else
unpack ps = build (unpackFoldr ps)
{-# INLINE unpack #-}
--
-- critical this isn't strict in the acc
-- as it will break in the presence of list fusion. this is a known
-- issue with seq and build/foldr rewrite rules, which rely on lazy
-- demanding to avoid bottoms in the list.
--
unpackFoldr :: ByteString -> (Word8 -> a -> a) -> a -> a
unpackFoldr (PS fp off len) f ch = withPtr fp $ \p -> do
let loop q n _ | q `seq` n `seq` False = undefined -- n.b.
loop _ (-1) acc = return acc
loop q n acc = do
a <- peekByteOff q n
loop q (n-1) (a `f` acc)
loop (p `plusPtr` off) (len-1) ch
{-# INLINE [0] unpackFoldr #-}
unpackList :: ByteString -> [Word8]
unpackList (PS fp off len) = withPtr fp $ \p -> do
let STRICT3(loop)
loop _ (-1) acc = return acc
loop q n acc = do
a <- peekByteOff q n
loop q (n-1) (a : acc)
loop (p `plusPtr` off) (len-1) []
{-# RULES
"unpack-list" [1] forall p . unpackFoldr p (:) [] = unpackList p
#-}
#endif
------------------------------------------------------------------------
-- | /O(n)/ Convert a '[a]' into a 'ByteString' using some
-- conversion function
packWith :: (a -> Word8) -> [a] -> ByteString
packWith k str = unsafeCreate (P.length str) $ \p -> go p str
where
STRICT2(go)
go _ [] = return ()
go p (x:xs) = poke p (k x) >> go (p `plusPtr` 1) xs -- less space than pokeElemOff
{-# INLINE packWith #-}
{-# SPECIALIZE packWith :: (Char -> Word8) -> [Char] -> ByteString #-}
-- | /O(n)/ Converts a 'ByteString' to a '[a]', using a conversion function.
unpackWith :: (Word8 -> a) -> ByteString -> [a]
unpackWith _ (PS _ _ 0) = []
unpackWith k (PS ps s l) = inlinePerformIO $ withForeignPtr ps $ \p ->
go (p `plusPtr` s) (l - 1) []
where
STRICT3(go)
go p 0 acc = peek p >>= \e -> return (k e : acc)
go p n acc = peekByteOff p n >>= \e -> go p (n-1) (k e : acc)
{-# INLINE unpackWith #-}
{-# SPECIALIZE unpackWith :: (Word8 -> Char) -> ByteString -> [Char] #-}
-- ---------------------------------------------------------------------
-- Basic interface
-- | /O(1)/ Test whether a ByteString is empty.
null :: ByteString -> Bool
null (PS _ _ l) = assert (l >= 0) $ l <= 0
{-# INLINE null #-}
-- ---------------------------------------------------------------------
-- | /O(1)/ 'length' returns the length of a ByteString as an 'Int'.
length :: ByteString -> Int
length (PS _ _ l) = assert (l >= 0) $ l
--
-- length/loop fusion. When taking the length of any fuseable loop,
-- rewrite it as a foldl', and thus avoid allocating the result buffer
-- worth around 10% in speed testing.
--
#if defined(__GLASGOW_HASKELL__)
{-# INLINE [1] length #-}
#endif
lengthU :: ByteString -> Int
lengthU = foldl' (const . (+1)) (0::Int)
{-# INLINE lengthU #-}
{-# RULES
-- v2 fusion
"length/loop" forall loop s .
length (loopArr (loopWrapper loop s)) =
lengthU (loopArr (loopWrapper loop s))
#-}
------------------------------------------------------------------------
-- | /O(n)/ 'cons' is analogous to (:) for lists, but of different
-- complexity, as it requires a memcpy.
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 #-}
-- | /O(n)/ Append a byte to the end of a 'ByteString'
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 #-}
-- todo fuse
-- | /O(1)/ Extract the first element of a ByteString, which must be non-empty.
-- An exception will be thrown in the case of an empty ByteString.
head :: ByteString -> Word8
head (PS x s l)
| l <= 0 = errorEmptyList "head"
| otherwise = inlinePerformIO $ withForeignPtr x $ \p -> peekByteOff p s
{-# INLINE head #-}
-- | /O(1)/ Extract the elements after the head of a ByteString, which must be non-empty.
-- An exception will be thrown in the case of an empty ByteString.
tail :: ByteString -> ByteString
tail (PS p s l)
| l <= 0 = errorEmptyList "tail"
| otherwise = PS p (s+1) (l-1)
{-# INLINE tail #-}
-- | /O(1)/ Extract the last element of a ByteString, which must be finite and non-empty.
-- An exception will be thrown in the case of an empty ByteString.
last :: ByteString -> Word8
last ps@(PS x s l)
| null ps = errorEmptyList "last"
| otherwise = inlinePerformIO $ withForeignPtr x $ \p -> peekByteOff p (s+l-1)
{-# INLINE last #-}
-- | /O(1)/ Return all the elements of a 'ByteString' except the last one.
-- An exception will be thrown in the case of an empty ByteString.
init :: ByteString -> ByteString
init ps@(PS p s l)
| null ps = errorEmptyList "init"
| otherwise = PS p s (l-1)
{-# INLINE init #-}
-- | /O(n)/ Append two ByteStrings
append :: ByteString -> ByteString -> ByteString
append xs ys | null xs = ys
| null ys = xs
| otherwise = concat [xs,ys]
{-# INLINE append #-}
-- ---------------------------------------------------------------------
-- Transformations
-- | /O(n)/ 'map' @f xs@ is the ByteString obtained by applying @f@ to each
-- element of @xs@. This function is subject to array fusion.
map :: (Word8 -> Word8) -> ByteString -> ByteString
#if defined(LOOPU_FUSION)
map f = loopArr . loopU (mapEFL f) NoAcc
#elif defined(LOOPUP_FUSION)
map f = loopArr . loopUp (mapEFL f) NoAcc
#elif defined(LOOPNOACC_FUSION)
map f = loopArr . loopNoAcc (mapEFL f)
#else
map f = loopArr . loopMap f
#endif
{-# INLINE map #-}
-- | /O(n)/ Like 'map', but not fuseable. The benefit is that it is
-- slightly faster for one-shot cases.
map' :: (Word8 -> Word8) -> ByteString -> ByteString
map' f (PS fp s len) = inlinePerformIO $ withForeignPtr fp $ \a ->
create len $ map_ 0 (a `plusPtr` s)
where
map_ :: Int -> Ptr Word8 -> Ptr Word8 -> IO ()
STRICT3(map_)
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' #-}
-- | /O(n)/ 'reverse' @xs@ efficiently returns the elements of @xs@ in reverse order.
reverse :: ByteString -> ByteString
reverse (PS x s l) = unsafeCreate l $ \p -> withForeignPtr x $ \f ->
c_reverse p (f `plusPtr` s) (fromIntegral l)
-- todo, fuseable version
-- | /O(n)/ The 'intersperse' function takes a 'Word8' and a
-- 'ByteString' and \`intersperses\' that byte between the elements of
-- the 'ByteString'. It is analogous to the intersperse function on
-- Lists.
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
{-
intersperse c = pack . List.intersperse c . unpack
-}
-- | The 'transpose' function transposes the rows and columns of its
-- 'ByteString' argument.
transpose :: [ByteString] -> [ByteString]
transpose ps = P.map pack (List.transpose (P.map unpack ps))
-- ---------------------------------------------------------------------
-- Reducing 'ByteString's
-- | 'foldl', applied to a binary operator, a starting value (typically
-- the left-identity of the operator), and a ByteString, reduces the
-- ByteString using the binary operator, from left to right.
-- This function is subject to array fusion.
foldl :: (a -> Word8 -> a) -> a -> ByteString -> a
#if !defined(LOOPU_FUSION)
foldl f z = loopAcc . loopUp (foldEFL f) z
#else
foldl f z = loopAcc . loopU (foldEFL f) z
#endif
{-# INLINE foldl #-}
{-
--
-- About twice as fast with 6.4.1, but not fuseable
-- A simple fold . map is enough to make it worth while.
--
foldl f v (PS x s l) = inlinePerformIO $ withForeignPtr x $ \ptr ->
lgo v (ptr `plusPtr` s) (ptr `plusPtr` (s+l))
where
STRICT3(lgo)
lgo z p q | p == q = return z
| otherwise = do c <- peek p
lgo (f z c) (p `plusPtr` 1) q
-}
-- | 'foldl\'' is like 'foldl', but strict in the accumulator.
-- Though actually foldl is also strict in the accumulator.
foldl' :: (a -> Word8 -> a) -> a -> ByteString -> a
foldl' = foldl
-- foldl' f z = loopAcc . loopU (foldEFL' f) z
{-# INLINE foldl' #-}
-- | 'foldr', applied to a binary operator, a starting value
-- (typically the right-identity of the operator), and a ByteString,
-- reduces the ByteString using the binary operator, from right to left.
foldr :: (Word8 -> a -> a) -> a -> ByteString -> a
foldr k z = loopAcc . loopDown (foldEFL (flip k)) z
{-# INLINE foldr #-}
-- | 'foldl1' is a variant of 'foldl' that has no starting value
-- argument, and thus must be applied to non-empty 'ByteStrings'.
-- This function is subject to array fusion.
-- An exception will be thrown in the case of an empty ByteString.
foldl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldl1 f ps
| null ps = errorEmptyList "foldl1"
| otherwise = foldl f (unsafeHead ps) (unsafeTail ps)
{-# INLINE foldl1 #-}
-- | 'foldl1\'' is like 'foldl1', but strict in the accumulator.
-- An exception will be thrown in the case of an empty ByteString.
foldl1' :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldl1' f ps
| null ps = errorEmptyList "foldl1'"
| otherwise = foldl' f (unsafeHead ps) (unsafeTail ps)
{-# INLINE foldl1' #-}
-- | 'foldr1' is a variant of 'foldr' that has no starting value argument,
-- and thus must be applied to non-empty 'ByteString's
-- An exception will be thrown in the case of an empty ByteString.
foldr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
foldr1 f ps
| null ps = errorEmptyList "foldr1"
| otherwise = foldr f (last ps) (init ps)
{-# INLINE foldr1 #-}
-- ---------------------------------------------------------------------
-- Special folds
-- | /O(n)/ Concatenate a list of ByteStrings.
concat :: [ByteString] -> ByteString
concat [] = empty
concat [ps] = ps
concat xs = unsafeCreate len $ \ptr -> go xs ptr
where len = P.sum . P.map length $ xs
STRICT2(go)
go [] _ = return ()
go (PS p s l:ps) ptr = do
withForeignPtr p $ \fp -> memcpy ptr (fp `plusPtr` s) (fromIntegral l)
go ps (ptr `plusPtr` l)
-- | Map a function over a 'ByteString' and concatenate the results
concatMap :: (Word8 -> ByteString) -> ByteString -> ByteString
concatMap f = concat . foldr ((:) . f) []
-- foldr (append . f) empty
-- | /O(n)/ Applied to a predicate and a ByteString, 'any' determines if
-- any element of the 'ByteString' satisfies the predicate.
any :: (Word8 -> Bool) -> ByteString -> Bool
any _ (PS _ _ 0) = False
any f (PS x s l) = inlinePerformIO $ withForeignPtr x $ \ptr ->
go (ptr `plusPtr` s) (ptr `plusPtr` (s+l))
where
STRICT2(go)
go p q | p == q = return False
| otherwise = do c <- peek p
if f c then return True
else go (p `plusPtr` 1) q
-- todo fuse
-- | /O(n)/ Applied to a predicate and a 'ByteString', 'all' determines
-- if all elements of the 'ByteString' satisfy the predicate.
all :: (Word8 -> Bool) -> ByteString -> Bool
all _ (PS _ _ 0) = True
all f (PS x s l) = inlinePerformIO $ withForeignPtr x $ \ptr ->
go (ptr `plusPtr` s) (ptr `plusPtr` (s+l))
where
STRICT2(go)
go p q | p == q = return True -- end of list
| otherwise = do c <- peek p
if f c
then go (p `plusPtr` 1) q
else return False
------------------------------------------------------------------------
-- | /O(n)/ 'maximum' returns the maximum value from a 'ByteString'
-- This function will fuse.
-- An exception will be thrown in the case of an empty ByteString.
maximum :: ByteString -> Word8
maximum xs@(PS x s l)
| null xs = errorEmptyList "maximum"
| otherwise = inlinePerformIO $ withForeignPtr x $ \p ->
c_maximum (p `plusPtr` s) (fromIntegral l)
-- | /O(n)/ 'minimum' returns the minimum value from a 'ByteString'
-- This function will fuse.
-- An exception will be thrown in the case of an empty ByteString.
minimum :: ByteString -> Word8
minimum xs@(PS x s l)
| null xs = errorEmptyList "minimum"
| otherwise = inlinePerformIO $ withForeignPtr x $ \p ->
c_minimum (p `plusPtr` s) (fromIntegral l)
--
-- minimum/maximum/loop fusion. As for length (and other folds), when we
-- see we're applied after a fuseable op, switch from using the C
-- version, to the fuseable version. The result should then avoid
-- allocating a buffer.
--
#if defined(__GLASGOW_HASKELL__)
{-# INLINE [1] minimum #-}
{-# INLINE [1] maximum #-}
#endif
maximumU :: ByteString -> Word8
maximumU = foldl1' max
{-# INLINE maximumU #-}
minimumU :: ByteString -> Word8
minimumU = foldl1' min
{-# INLINE minimumU #-}
{-# RULES
"minimum/loop" forall loop s .
minimum (loopArr (loopWrapper loop s)) =
minimumU (loopArr (loopWrapper loop s))
"maximum/loop" forall loop s .
maximum (loopArr (loopWrapper loop s)) =
maximumU (loopArr (loopWrapper loop s))
#-}
------------------------------------------------------------------------
-- | The 'mapAccumL' function behaves like a combination of 'map' and
-- 'foldl'; it applies a function to each element of a ByteString,
-- passing an accumulating parameter from left to right, and returning a
-- final value of this accumulator together with the new list.
mapAccumL :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)
#if !defined(LOOPU_FUSION)
mapAccumL f z = unSP . loopUp (mapAccumEFL f) z
#else
mapAccumL f z = unSP . loopU (mapAccumEFL f) z
#endif
{-# INLINE mapAccumL #-}
-- | The 'mapAccumR' function behaves like a combination of 'map' and
-- 'foldr'; it applies a function to each element of a ByteString,
-- passing an accumulating parameter from right to left, and returning a
-- final value of this accumulator together with the new ByteString.
mapAccumR :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)
mapAccumR f z = unSP . loopDown (mapAccumEFL f) z
{-# INLINE mapAccumR #-}
-- | /O(n)/ map Word8 functions, provided with the index at each position
mapIndexed :: (Int -> Word8 -> Word8) -> ByteString -> ByteString
mapIndexed f = loopArr . loopUp (mapIndexEFL f) 0
{-# INLINE mapIndexed #-}
-- ---------------------------------------------------------------------
-- Building ByteStrings
-- | 'scanl' is similar to 'foldl', but returns a list of successive
-- reduced values from the left. This function will fuse.
--
-- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]
--
-- Note that
--
-- > last (scanl f z xs) == foldl f z xs.
scanl :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
#if !defined(LOOPU_FUSION)
scanl f z ps = loopArr . loopUp (scanEFL f) z $ (ps `snoc` 0)
#else
scanl f z ps = loopArr . loopU (scanEFL f) z $ (ps `snoc` 0)
#endif
-- n.b. haskell's List scan returns a list one bigger than the
-- input, so we need to snoc here to get some extra space, however,
-- it breaks map/up fusion (i.e. scanl . map no longer fuses)
{-# INLINE scanl #-}
-- | 'scanl1' is a variant of 'scanl' that has no starting value argument.
-- This function will fuse.
--
-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
scanl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
scanl1 f ps
| null ps = empty
| otherwise = scanl f (unsafeHead ps) (unsafeTail ps)
{-# INLINE scanl1 #-}
-- | scanr is the right-to-left dual of scanl.
scanr :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
scanr f z ps = loopArr . loopDown (scanEFL (flip f)) z $ (0 `cons` ps) -- extra space
{-# INLINE scanr #-}
-- | 'scanr1' is a variant of 'scanr' that has no starting value argument.
scanr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
scanr1 f ps
| null ps = empty
| otherwise = scanr f (last ps) (init ps) -- todo, unsafe versions
{-# INLINE scanr1 #-}
-- ---------------------------------------------------------------------
-- Unfolds and replicates
-- | /O(n)/ 'replicate' @n x@ is a ByteString of length @n@ with @x@
-- the value of every element. The following holds:
--
-- > replicate w c = unfoldr w (\u -> Just (u,u)) c
--
-- This implemenation uses @memset(3)@
replicate :: Int -> Word8 -> ByteString
replicate w c
| w <= 0 = empty
| otherwise = unsafeCreate w $ \ptr ->
memset ptr c (fromIntegral w) >> return ()
-- | /O(n)/, where /n/ is the length of the result. The 'unfoldr'
-- function is analogous to the List \'unfoldr\'. 'unfoldr' builds a
-- ByteString from a seed value. The function takes the element and
-- returns 'Nothing' if it is done producing the ByteString or returns
-- 'Just' @(a,b)@, in which case, @a@ is the next byte in the string,
-- and @b@ is the seed value for further production.
--
-- Examples:
--
-- > unfoldr (\x -> if x <= 5 then Just (x, x + 1) else Nothing) 0
-- > == pack [0, 1, 2, 3, 4, 5]
--
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'
-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a ByteString from a seed
-- value. However, the length of the result is limited by the first
-- argument to 'unfoldrN'. This function is more efficient than 'unfoldr'
-- when the maximum length of the result is known.
--
-- The following equation relates 'unfoldrN' and 'unfoldr':
--
-- > unfoldrN n f s == take n (unfoldr f s)
--
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 STRICT3(go)
go p x n =
case f x of
Nothing -> return (0, n, Nothing)
Just (w,x')
| n == i -> return (0, n, Just x)
| otherwise -> do poke p w
go (p `plusPtr` 1) x' (n+1)
-- ---------------------------------------------------------------------
-- Substrings
-- | /O(1)/ 'take' @n@, applied to a ByteString @xs@, returns the prefix
-- of @xs@ of length @n@, or @xs@ itself if @n > 'length' xs@.
take :: Int -> ByteString -> ByteString
take n ps@(PS x s l)
| n <= 0 = empty
| n >= l = ps
| otherwise = PS x s n
{-# INLINE take #-}
-- | /O(1)/ 'drop' @n xs@ returns the suffix of @xs@ after the first @n@
-- elements, or @[]@ if @n > 'length' xs@.
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 #-}
-- | /O(1)/ 'splitAt' @n xs@ is equivalent to @('take' n xs, 'drop' n xs)@.
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', applied to a predicate @p@ and a ByteString @xs@,
-- returns the longest prefix (possibly empty) of @xs@ of elements that
-- satisfy @p@.
takeWhile :: (Word8 -> Bool) -> ByteString -> ByteString
takeWhile f ps = unsafeTake (findIndexOrEnd (not . f) ps) ps
{-# INLINE takeWhile #-}
-- | 'dropWhile' @p xs@ returns the suffix remaining after 'takeWhile' @p xs@.
dropWhile :: (Word8 -> Bool) -> ByteString -> ByteString
dropWhile f ps = unsafeDrop (findIndexOrEnd (not . f) ps) ps
{-# INLINE dropWhile #-}
-- | 'break' @p@ is equivalent to @'span' ('not' . p)@.
break :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
break p ps = case findIndexOrEnd p ps of n -> (unsafeTake n ps, unsafeDrop n ps)
{-# INLINE break #-}
-- | 'breakEnd' behaves like 'break' but from the end of the 'ByteString'
--
-- breakEnd p == spanEnd (not.p)
breakEnd :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
breakEnd p ps = splitAt (findFromEndUntil p ps) ps
-- | 'breakByte' breaks its ByteString argument at the first occurence
-- of the specified byte. It is more efficient than 'break' as it is
-- implemented with @memchr(3)@. I.e.
--
-- > break (=='c') "abcd" == breakByte 'c' "abcd"
--
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 #-}
-- | 'spanByte' breaks its ByteString argument at the first
-- occurence of a byte other than its argument. It is more efficient
-- than 'span (==)'
--
-- > span (=='c') "abcd" == spanByte 'c' "abcd"
--
spanByte :: Word8 -> ByteString -> (ByteString, ByteString)
spanByte c ps@(PS x s l) = inlinePerformIO $ withForeignPtr x $ \p ->
go (p `plusPtr` s) 0
where
STRICT2(go)
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 #-}
-- | 'span' @p xs@ breaks the ByteString into two segments. It is
-- equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@
span :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
span p ps = break (not . p) ps
{-# INLINE span #-}
-- | 'spanEnd' behaves like 'span' but from the end of the 'ByteString'.
-- We have
--
-- > spanEnd (not.isSpace) "x y z" == ("x y ","z")
--
-- and
--
-- > spanEnd (not . isSpace) ps
-- > ==
-- > let (x,y) = span (not.isSpace) (reverse ps) in (reverse y, reverse x)
--
spanEnd :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
spanEnd p ps = splitAt (findFromEndUntil (not.p) ps) ps
-- | /O(n)/ Splits a 'ByteString' into components delimited by
-- separators, where the predicate returns True for a separator element.
-- The resulting components do not contain the separators. Two adjacent
-- separators result in an empty component in the output. eg.
--
-- > splitWith (=='a') "aabbaca" == ["","","bb","c",""]
-- > splitWith (=='a') [] == []
--
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#)
STRICT4(splitWith0)
splitWith0 pred' off' len' fp' = withPtr 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'
| pred' `seq` p `seq` idx' `seq` off' `seq` len' `seq` fp' `seq` False = undefined
| 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
STRICT2(loop)
loop q qs = if null rest then [chunk]
else chunk : loop q (unsafeTail rest)
where (chunk,rest) = break q qs
#endif
-- | /O(n)/ Break a 'ByteString' into pieces separated by the byte
-- argument, consuming the delimiter. I.e.
--
-- > split '\n' "a\nb\nd\ne" == ["a","b","d","e"]
-- > split 'a' "aXaXaXa" == ["","X","X","X"]
-- > split 'x' "x" == ["",""]
--
-- and
--
-- > join [c] . split c == id
-- > split == splitWith . (==)
--
-- As for all splitting functions in this library, this function does
-- not copy the substrings, it just constructs new 'ByteStrings' that
-- are slices of the original.
--
split :: Word8 -> ByteString -> [ByteString]
split _ (PS _ _ 0) = []
split w (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> do
let ptr = p `plusPtr` s
STRICT1(loop)
loop n =
let q = inlinePerformIO $ memchr (ptr `plusPtr` n)
w (fromIntegral (l-n))
in if q == nullPtr
then [PS x (s+n) (l-n)]
else let i = q `minusPtr` ptr in PS x (s+n) (i-n) : loop (i+1)
return (loop 0)
{-# INLINE split #-}
{-
-- slower. but stays inside Haskell.
split _ (PS _ _ 0) = []
split (W8# w#) (PS fp off len) = splitWith' off len fp
where
splitWith' off' len' fp' = withPtr fp $ \p ->
splitLoop p 0 off' len' fp'
splitLoop :: Ptr Word8
-> Int -> Int -> Int
-> ForeignPtr Word8
-> IO [ByteString]
STRICT5(splitLoop)
splitLoop p idx' off' len' fp'
| p `seq` idx' `seq` off' `seq` len' `seq` fp' `seq` False = undefined
| idx' >= len' = return [PS fp' off' idx']
| otherwise = do
(W8# x#) <- peekElemOff p (off'+idx')
if word2Int# w# ==# word2Int# x#
then return (PS fp' off' idx' :
splitWith' (off'+idx'+1) (len'-idx'-1) fp')
else splitLoop p (idx'+1) off' len' fp'
-}
-- | Like 'splitWith', except that sequences of adjacent separators are
-- treated as a single separator. eg.
--
-- > tokens (=='a') "aabbaca" == ["bb","c"]
--
tokens :: (Word8 -> Bool) -> ByteString -> [ByteString]
tokens f = P.filter (not.null) . splitWith f
{-# INLINE tokens #-}
-- | The 'group' function takes a ByteString and returns a list of
-- ByteStrings such that the concatenation of the result is equal to the
-- argument. Moreover, each sublist in the result contains only equal
-- elements. For example,
--
-- > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"]
--
-- It is a special case of 'groupBy', which allows the programmer to
-- supply their own equality test. It is about 40% faster than
-- /groupBy (==)/
group :: ByteString -> [ByteString]
group xs
| null xs = []
| otherwise = ys : group zs
where
(ys, zs) = spanByte (unsafeHead xs) xs
-- | The 'groupBy' function is the non-overloaded version of 'group'.
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)
-- | /O(n)/ The 'join' function takes a 'ByteString' and a list of
-- 'ByteString's and concatenates the list after interspersing the first
-- argument between each element of the list.
join :: ByteString -> [ByteString] -> ByteString
join s = concat . (List.intersperse s)
{-# INLINE join #-}
--
-- | /O(n)/ joinWithByte. An efficient way to join to two ByteStrings
-- with a char. Around 4 times faster than the generalised join.
--
joinWithByte :: Word8 -> ByteString -> ByteString -> ByteString
joinWithByte 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 joinWithByte #-}
-- ---------------------------------------------------------------------
-- Indexing ByteStrings
-- | /O(1)/ 'ByteString' index (subscript) operator, starting from 0.
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 #-}
-- | /O(n)/ The 'elemIndex' function returns the index of the first
-- element in the given 'ByteString' which is equal to the query
-- element, or 'Nothing' if there is no such element.
-- This implementation uses memchr(3).
elemIndex :: Word8 -> ByteString -> Maybe Int
elemIndex c (PS x s l) = inlinePerformIO $ 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 #-}
-- | /O(n)/ The 'elemIndexEnd' function returns the last index of the
-- element in the given 'ByteString' which is equal to the query
-- element, or 'Nothing' if there is no such element. The following
-- holds:
--
-- > elemIndexEnd c xs ==
-- > (-) (length xs - 1) `fmap` elemIndex c (reverse xs)
--
elemIndexEnd :: Word8 -> ByteString -> Maybe Int
elemIndexEnd ch (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p ->
go (p `plusPtr` s) (l-1)
where
STRICT2(go)
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 #-}
-- | /O(n)/ The 'elemIndices' function extends 'elemIndex', by returning
-- the indices of all elements equal to the query element, in ascending order.
-- This implementation uses memchr(3).
elemIndices :: Word8 -> ByteString -> [Int]
elemIndices w (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> do
let ptr = p `plusPtr` s
STRICT1(loop)
loop n = let q = inlinePerformIO $ memchr (ptr `plusPtr` n)
w (fromIntegral (l - n))
in if q == nullPtr
then []
else let i = q `minusPtr` ptr
in i : loop (i+1)
return $! loop 0
{-# INLINE elemIndices #-}
{-
-- much slower
elemIndices :: Word8 -> ByteString -> [Int]
elemIndices c ps = loop 0 ps
where STRICT2(loop)
loop _ ps' | null ps' = []
loop n ps' | c == unsafeHead ps' = n : loop (n+1) (unsafeTail ps')
| otherwise = loop (n+1) (unsafeTail ps')
-}
-- | count returns the number of times its argument appears in the ByteString
--
-- > count = length . elemIndices
--
-- But more efficiently than using length on the intermediate list.
count :: Word8 -> ByteString -> Int
count w (PS x s m) = inlinePerformIO $ withForeignPtr x $ \p ->
fmap fromIntegral $ c_count (p `plusPtr` s) (fromIntegral m) w
{-# INLINE count #-}
{-
--
-- around 30% slower
--
count w (PS x s m) = inlinePerformIO $ withForeignPtr x $ \p ->
go (p `plusPtr` s) (fromIntegral m) 0
where
go :: Ptr Word8 -> CSize -> Int -> IO Int
STRICT3(go)
go p l i = do
q <- memchr p w l
if q == nullPtr
then return i
else do let k = fromIntegral $ q `minusPtr` p
go (q `plusPtr` 1) (l-k-1) (i+1)
-}
-- | The 'findIndex' function takes a predicate and a 'ByteString' and
-- returns the index of the first element in the ByteString
-- satisfying the predicate.
findIndex :: (Word8 -> Bool) -> ByteString -> Maybe Int
findIndex k (PS x s l) = inlinePerformIO $ withForeignPtr x $ \f -> go (f `plusPtr` s) 0
where
STRICT2(go)
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 #-}
-- | The 'findIndices' function extends 'findIndex', by returning the
-- indices of all elements satisfying the predicate, in ascending order.
findIndices :: (Word8 -> Bool) -> ByteString -> [Int]
findIndices p ps = loop 0 ps
where
STRICT2(loop)
loop n qs | null qs = []
| p (unsafeHead qs) = n : loop (n+1) (unsafeTail qs)
| otherwise = loop (n+1) (unsafeTail qs)
-- | 'findIndexOrEnd' is a variant of findIndex, that returns the length
-- of the string if no element is found, rather than Nothing.
findIndexOrEnd :: (Word8 -> Bool) -> ByteString -> Int
findIndexOrEnd k (PS x s l) = inlinePerformIO $ withForeignPtr x $ \f -> go (f `plusPtr` s) 0
where
STRICT2(go)
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 #-}
-- ---------------------------------------------------------------------
-- Searching ByteStrings
-- | /O(n)/ 'elem' is the 'ByteString' membership predicate.
elem :: Word8 -> ByteString -> Bool
elem c ps = case elemIndex c ps of Nothing -> False ; _ -> True
{-# INLINE elem #-}
-- | /O(n)/ 'notElem' is the inverse of 'elem'
notElem :: Word8 -> ByteString -> Bool
notElem c ps = not (elem c ps)
{-# INLINE notElem #-}
-- | /O(n)/ 'filter', applied to a predicate and a ByteString,
-- returns a ByteString containing those characters that satisfy the
-- predicate. This function is subject to array fusion.
filter :: (Word8 -> Bool) -> ByteString -> ByteString
#if defined(LOOPU_FUSION)
filter p = loopArr . loopU (filterEFL p) NoAcc
#elif defined(LOOPUP_FUSION)
filter p = loopArr . loopUp (filterEFL p) NoAcc
#elif defined(LOOPNOACC_FUSION)
filter p = loopArr . loopNoAcc (filterEFL p)
#else
filter f = loopArr . loopFilter f
#endif
{-# INLINE filter #-}
-- | /O(n)/ 'filter\'' is a non-fuseable version of filter, that may be
-- around 2x faster for some one-shot applications.
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 -- actual length
where
STRICT3(go)
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' #-}
--
-- | /O(n)/ A first order equivalent of /filter . (==)/, for the common
-- case of filtering a single byte. It is more efficient to use
-- /filterByte/ in this case.
--
-- > filterByte == filter . (==)
--
-- filterByte is around 10x faster, and uses much less space, than its
-- filter equivalent
filterByte :: Word8 -> ByteString -> ByteString
filterByte w ps = replicate (count w ps) w
{-# INLINE filterByte #-}
--
-- | /O(n)/ A first order equivalent of /filter . (\/=)/, for the common
-- case of filtering a single byte out of a list. It is more efficient
-- to use /filterNotByte/ in this case.
--
-- > filterNotByte == filter . (/=)
--
-- filterNotByte is around 2x faster than its filter equivalent.
filterNotByte :: Word8 -> ByteString -> ByteString
filterNotByte w = filter' (/= w)
{-# INLINE filterNotByte #-}
-- | /O(n)/ The 'find' function takes a predicate and a ByteString,
-- and returns the first element in matching the predicate, or 'Nothing'
-- if there is no such element.
--
-- > find f p = case findIndex f p of Just n -> Just (p ! n) ; _ -> Nothing
--
find :: (Word8 -> Bool) -> ByteString -> Maybe Word8
find f p = case findIndex f p of
Just n -> Just (p `unsafeIndex` n)
_ -> Nothing
{-# INLINE find #-}
{-
--
-- fuseable, but we don't want to walk the whole array.
--
find k = foldl findEFL Nothing
where findEFL a@(Just _) _ = a
findEFL _ c | k c = Just c
| otherwise = Nothing
-}
-- ---------------------------------------------------------------------
-- Searching for substrings
-- | /O(n)/ The 'isPrefixOf' function takes two ByteStrings and returns 'True'
-- iff the first is a prefix of the second.
isPrefixOf :: ByteString -> ByteString -> Bool
isPrefixOf (PS x1 s1 l1) (PS x2 s2 l2)
| l1 == 0 = True
| l2 < l1 = False
| otherwise = inlinePerformIO $ withForeignPtr x1 $ \p1 ->
withForeignPtr x2 $ \p2 -> do
i <- memcmp (p1 `plusPtr` s1) (p2 `plusPtr` s2) (fromIntegral l1)
return $! i == 0
-- | /O(n)/ The 'isSuffixOf' function takes two ByteStrings and returns 'True'
-- iff the first is a suffix of the second.
--
-- The following holds:
--
-- > isSuffixOf x y == reverse x `isPrefixOf` reverse y
--
-- However, the real implemenation uses memcmp to compare the end of the
-- string only, with no reverse required..
isSuffixOf :: ByteString -> ByteString -> Bool
isSuffixOf (PS x1 s1 l1) (PS x2 s2 l2)
| l1 == 0 = True
| l2 < l1 = False
| otherwise = inlinePerformIO $ withForeignPtr x1 $ \p1 ->
withForeignPtr x2 $ \p2 -> do
i <- memcmp (p1 `plusPtr` s1) (p2 `plusPtr` s2 `plusPtr` (l2 - l1)) (fromIntegral l1)
return $! i == 0
-- | Check whether one string is a substring of another. @isSubstringOf
-- p s@ is equivalent to @not (null (findSubstrings p s))@.
isSubstringOf :: ByteString -- ^ String to search for.
-> ByteString -- ^ String to search in.
-> Bool
isSubstringOf p s = not $ P.null $ findSubstrings p s
-- | Get the first index of a substring in another string,
-- or 'Nothing' if the string is not found.
-- @findSubstring p s@ is equivalent to @listToMaybe (findSubstrings p s)@.
findSubstring :: ByteString -- ^ String to search for.
-> ByteString -- ^ String to seach in.
-> Maybe Int
findSubstring = (listToMaybe .) . findSubstrings
-- | Find the indexes of all (possibly overlapping) occurances of a
-- substring in a string. This function uses the Knuth-Morris-Pratt
-- string matching algorithm.
findSubstrings :: ByteString -- ^ String to search for.
-> ByteString -- ^ String to seach in.
-> [Int]
findSubstrings pat@(PS _ _ m) str@(PS _ _ n) = search 0 0
where
patc x = pat `unsafeIndex` x
strc x = str `unsafeIndex` x
-- maybe we should make kmpNext a UArray before using it in search?
kmpNext = listArray (0,m) (-1:kmpNextL pat (-1))
kmpNextL p _ | null p = []
kmpNextL p j = let j' = next (unsafeHead p) j + 1
ps = unsafeTail p
x = if not (null ps) && unsafeHead ps == patc j'
then kmpNext Array.! j' else j'
in x:kmpNextL ps j'
search i j = match ++ rest -- i: position in string, j: position in pattern
where match = if j == m then [(i - j)] else []
rest = if i == n then [] else search (i+1) (next (strc i) j + 1)
next c j | j >= 0 && (j == m || c /= patc j) = next c (kmpNext Array.! j)
| otherwise = j
-- ---------------------------------------------------------------------
-- Zipping
-- | /O(n)/ 'zip' takes two ByteStrings and returns a list of
-- corresponding pairs of bytes. If one input ByteString is short,
-- excess elements of the longer ByteString are discarded. This is
-- equivalent to a pair of 'unpack' operations.
zip :: ByteString -> ByteString -> [(Word8,Word8)]
zip ps qs
| null ps || null qs = []
| otherwise = (unsafeHead ps, unsafeHead qs) : zip (unsafeTail ps) (unsafeTail qs)
-- | 'zipWith' generalises 'zip' by zipping with the function given as
-- the first argument, instead of a tupling function. For example,
-- @'zipWith' (+)@ is applied to two ByteStrings to produce the list of
-- corresponding sums.
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)
--
-- | A specialised version of zipWith for the common case of a
-- simultaneous map over two bytestrings, to build a 3rd. Rewrite rules
-- are used to automatically covert zipWith into zipWith' when a pack is
-- performed on the result of zipWith, but we also export it for
-- convenience.
--
zipWith' :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> ByteString
zipWith' f (PS fp s l) (PS fq t m) = inlinePerformIO $
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 ()
STRICT4(zipWith_)
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
"Specialise zipWith" forall (f :: Word8 -> Word8 -> Word8) p q .
pack (zipWith f p q) = zipWith' f p q
#-}
-- | /O(n)/ 'unzip' transforms a list of pairs of bytes into a pair of
-- ByteStrings. Note that this performs two 'pack' operations.
unzip :: [(Word8,Word8)] -> (ByteString,ByteString)
unzip ls = (pack (P.map fst ls), pack (P.map snd ls))
{-# INLINE unzip #-}
-- ---------------------------------------------------------------------
-- Special lists
-- | /O(n)/ Return all initial segments of the given 'ByteString', shortest first.
inits :: ByteString -> [ByteString]
inits (PS x s l) = [PS x s n | n <- [0..l]]
-- | /O(n)/ Return all final segments of the given 'ByteString', longest first.
tails :: ByteString -> [ByteString]
tails p | null p = [empty]
| otherwise = p : tails (unsafeTail p)
-- less efficent spacewise: tails (PS x s l) = [PS x (s+n) (l-n) | n <- [0..l]]
-- ---------------------------------------------------------------------
-- ** Ordered 'ByteString's
-- | /O(n)/ Sort a ByteString efficiently, using counting sort.
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 STRICT2(go)
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
{-
sort :: ByteString -> ByteString
sort (PS x s l) = unsafeCreate l $ \p -> withForeignPtr x $ \f -> do
memcpy p (f `plusPtr` s) l
c_qsort p l -- inplace
-}
-- | The 'sortBy' function is the non-overloaded version of 'sort'.
--
-- Try some linear sorts: radix, counting
-- Or mergesort.
--
-- sortBy :: (Word8 -> Word8 -> Ordering) -> ByteString -> ByteString
-- sortBy f ps = undefined
-- ---------------------------------------------------------------------
-- Low level constructors
-- | /O(n)/ Build a @ByteString@ from a @CString@. This value will have /no/
-- finalizer associated to it. The ByteString length is calculated using
-- /strlen(3)/, and thus the complexity is a /O(n)/.
packCString :: CString -> ByteString
packCString cstr = unsafePerformIO $ do
fp <- newForeignPtr_ (castPtr cstr)
l <- c_strlen cstr
return $! PS fp 0 (fromIntegral l)
-- | /O(1)/ Build a @ByteString@ from a @CStringLen@. This value will
-- have /no/ finalizer associated with it. This operation has /O(1)/
-- complexity as we already know the final size, so no /strlen(3)/ is
-- required.
packCStringLen :: CStringLen -> ByteString
packCStringLen (ptr,len) = unsafePerformIO $ do
fp <- newForeignPtr_ (castPtr ptr)
return $! PS fp 0 (fromIntegral len)
-- | /O(n)/ Build a @ByteString@ from a malloced @CString@. This value will
-- have a @free(3)@ finalizer associated to it.
packMallocCString :: CString -> ByteString
packMallocCString cstr = unsafePerformIO $ do
fp <- newForeignFreePtr (castPtr cstr)
len <- c_strlen cstr
return $! PS fp 0 (fromIntegral len)
-- | /O(n) construction/ Use a @ByteString@ with a function requiring a
-- null-terminated @CString@. The @CString@ will be freed
-- automatically. This is a memcpy(3).
useAsCString :: ByteString -> (CString -> IO a) -> IO a
useAsCString (PS ps s l) = bracket alloc (c_free.castPtr)
where alloc = withForeignPtr ps $ \p -> do
buf <- c_malloc (fromIntegral l+1)
memcpy (castPtr buf) (castPtr p `plusPtr` s) (fromIntegral l)
poke (buf `plusPtr` l) (0::Word8) -- n.b.
return (castPtr buf)
-- | /O(1) construction/ Use a @ByteString@ with a function requiring a @CStringLen@.
useAsCStringLen :: ByteString -> (CStringLen -> IO a) -> IO a
useAsCStringLen = unsafeUseAsCStringLen
--
-- why were we doing this?
--
-- useAsCStringLen :: ByteString -> (CStringLen -> IO a) -> IO a
-- useAsCStringLen (PS ps s l) = bracket alloc (c_free.castPtr.fst)
-- where
-- alloc = withForeignPtr ps $ \p -> do
-- buf <- c_malloc (fromIntegral l+1)
-- memcpy (castPtr buf) (castPtr p `plusPtr` s) (fromIntegral l)
-- poke (buf `plusPtr` l) (0::Word8) -- n.b.
-- return $! (castPtr buf, l)
--
-- | /O(n)/ Make a copy of the 'ByteString' with its own storage.
-- This is mainly useful to allow the rest of the data pointed
-- to by the 'ByteString' to be garbage collected, for example
-- if a large string has been read in, and only a small part of it
-- is needed in the rest of the program.
copy :: ByteString -> ByteString
copy (PS x s l) = unsafeCreate l $ \p -> withForeignPtr x $ \f ->
memcpy p (f `plusPtr` s) (fromIntegral l)
-- | /O(n)/ Duplicate a CString as a ByteString. Useful if you know the
-- CString is going to be deallocated from C land.
copyCString :: CString -> IO ByteString
copyCString cstr = do
len <- c_strlen cstr
copyCStringLen (cstr, fromIntegral len)
-- | /O(n)/ Same as copyCString, but saves a strlen call when the length is known.
copyCStringLen :: CStringLen -> IO ByteString
copyCStringLen (cstr, len) = create len $ \p ->
memcpy p (castPtr cstr) (fromIntegral len)
-- ---------------------------------------------------------------------
-- line IO
-- | Read a line from stdin.
getLine :: IO ByteString
getLine = hGetLine stdin
-- | Lazily construct a list of lines of ByteStrings. This will be much
-- better on memory consumption than using 'hGetContents >>= lines'
-- If you're considering this, a better choice might be to use
-- Data.ByteString.Lazy
hGetLines :: Handle -> IO [ByteString]
hGetLines h = go
where
go = unsafeInterleaveIO $ do
e <- hIsEOF h
if e
then return []
else do
x <- hGetLine h
xs <- go
return (x:xs)
-- | Read a line from a handle
hGetLine :: Handle -> IO ByteString
#if !defined(__GLASGOW_HASKELL__)
hGetLine h = do
string <- System.IO.hGetLine h
return $ packWith c2w string
#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 =
len `seq` do
off <- findEOL r w raw
let new_len = len + off - r
xs <- mkPS raw r off
-- if eol == True, then off is the offset of the '\n'
-- otherwise off == w and the buffer is now empty.
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 indicates we caught an EOF, and we may have a
-- partial line to return.
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)
-- find the end-of-line character, if there is one
findEOL r w raw
| r == w = return w
| otherwise = do
(c,r') <- readCharFromBuffer raw r
if c == '\n'
then return r -- NB. not r': don't include the '\n'
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)
-- TODO, rewrite to use normal memcpy
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 ()
mkBigPS :: Int -> [ByteString] -> IO ByteString
mkBigPS _ [ps] = return ps
mkBigPS _ pss = return $! concat (P.reverse pss)
#endif
-- ---------------------------------------------------------------------
-- Block IO
-- | Outputs a 'ByteString' to the specified 'Handle'.
hPut :: Handle -> ByteString -> IO ()
hPut _ (PS _ _ 0) = return ()
hPut h (PS ps s l) = withForeignPtr ps $ \p-> hPutBuf h (p `plusPtr` s) l
-- | A synonym for @hPut@, for compatibility
hPutStr :: Handle -> ByteString -> IO ()
hPutStr = hPut
-- | Write a ByteString to a handle, appending a newline byte
hPutStrLn :: Handle -> ByteString -> IO ()
hPutStrLn h ps
| length ps < 1024 = hPut h (ps `snoc` 0x0a)
| otherwise = hPut h ps >> hPut h (singleton (0x0a)) -- don't copy
-- | Write a ByteString to stdout
putStr :: ByteString -> IO ()
putStr = hPut stdout
-- | Write a ByteString to stdout, appending a newline byte
putStrLn :: ByteString -> IO ()
putStrLn = hPutStrLn stdout
-- | Read a 'ByteString' directly from the specified 'Handle'. This
-- is far more efficient than reading the characters into a 'String'
-- and then using 'pack'.
hGet :: Handle -> Int -> IO ByteString
hGet _ 0 = return empty
hGet h i = createAndTrim i $ \p -> hGetBuf h p i
-- | hGetNonBlocking is identical to 'hGet', except that it will never block
-- waiting for data to become available, instead it returns only whatever data
-- is available.
hGetNonBlocking :: Handle -> Int -> IO ByteString
#if defined(__GLASGOW_HASKELL__)
hGetNonBlocking _ 0 = return empty
hGetNonBlocking h i = createAndTrim i $ \p -> hGetBufNonBlocking h p i
#else
hGetNonBlocking = hGet
#endif
-- | Read entire handle contents into a 'ByteString'.
-- This function reads chunks at a time, doubling the chunksize on each
-- read. The final buffer is then realloced to the appropriate size. For
-- files > half of available memory, this may lead to memory exhaustion.
-- Consider using 'readFile' in this case.
--
-- As with 'hGet', the string representation in the file is assumed to
-- be ISO-8859-1.
--
hGetContents :: Handle -> IO ByteString
hGetContents h = do
let start_size = 1024
p <- mallocArray start_size
i <- hGetBuf h p start_size
if i < start_size
then do p' <- reallocArray p i
fp <- newForeignFreePtr p'
return $! PS fp 0 i
else f p start_size
where
f p s = do
let s' = 2 * s
p' <- reallocArray p s'
i <- hGetBuf h (p' `plusPtr` s) s
if i < s
then do let i' = s + i
p'' <- reallocArray p' i'
fp <- newForeignFreePtr p''
return $! PS fp 0 i'
else f p' s'
-- | getContents. Equivalent to hGetContents stdin
getContents :: IO ByteString
getContents = hGetContents stdin
-- | The interact function takes a function of type @ByteString -> ByteString@
-- as its argument. The entire input from the standard input device is passed
-- to this function as its argument, and the resulting string is output on the
-- standard output device. It's great for writing one line programs!
interact :: (ByteString -> ByteString) -> IO ()
interact transformer = putStr . transformer =<< getContents
-- | Read an entire file strictly into a 'ByteString'. This is far more
-- efficient than reading the characters into a 'String' and then using
-- 'pack'. It also may be more efficient than opening the file and
-- reading it using hGet. Files are read using 'binary mode' on Windows,
-- for 'text mode' use the Char8 version of this function.
readFile :: FilePath -> IO ByteString
readFile f = bracket (openBinaryFile f ReadMode) hClose
(\h -> hFileSize h >>= hGet h . fromIntegral)
-- | Write a 'ByteString' to a file.
writeFile :: FilePath -> ByteString -> IO ()
writeFile f txt = bracket (openBinaryFile f WriteMode) hClose
(\h -> hPut h txt)
-- | Append a 'ByteString' to a file.
appendFile :: FilePath -> ByteString -> IO ()
appendFile f txt = bracket (openBinaryFile f AppendMode) hClose
(\h -> hPut h txt)
{-
--
-- Disable until we can move it into a portable .hsc file
--
-- | Like readFile, this reads an entire file directly into a
-- 'ByteString', but it is even more efficient. It involves directly
-- mapping the file to memory. This has the advantage that the contents
-- of the file never need to be copied. Also, under memory pressure the
-- page may simply be discarded, while in the case of readFile it would
-- need to be written to swap. If you read many small files, mmapFile
-- will be less memory-efficient than readFile, since each mmapFile
-- takes up a separate page of memory. Also, you can run into bus
-- errors if the file is modified. As with 'readFile', the string
-- representation in the file is assumed to be ISO-8859-1.
--
-- On systems without mmap, this is the same as a readFile.
--
mmapFile :: FilePath -> IO ByteString
mmapFile f = mmap f >>= \(fp,l) -> return $! PS fp 0 l
mmap :: FilePath -> IO (ForeignPtr Word8, Int)
mmap f = do
h <- openBinaryFile f ReadMode
l <- fromIntegral `fmap` hFileSize h
-- Don't bother mmaping small files because each mmapped file takes up
-- at least one full VM block.
if l < mmap_limit
then do thefp <- mallocByteString l
withForeignPtr thefp $ \p-> hGetBuf h p l
hClose h
return (thefp, l)
else do
-- unix only :(
fd <- fromIntegral `fmap` handleToFd h
p <- my_mmap l fd
fp <- if p == nullPtr
then do thefp <- mallocByteString l
withForeignPtr thefp $ \p' -> hGetBuf h p' l
return thefp
else do
-- The munmap leads to crashes on OpenBSD.
-- maybe there's a use after unmap in there somewhere?
-- Bulat suggests adding the hClose to the
-- finalizer, excellent idea.
#if !defined(__OpenBSD__)
let unmap = c_munmap p l >> return ()
#else
let unmap = return ()
#endif
fp <- FC.newForeignPtr p unmap
return fp
c_close fd
hClose h
return (fp, l)
where mmap_limit = 16*1024
-}
--
-- | A ByteString equivalent for getArgs. More efficient for large argument lists
--
getArgs :: IO [ByteString]
#if defined(__GLASGOW_HASKELL__)
getArgs =
alloca $ \ p_argc ->
alloca $ \ p_argv -> do
getProgArgv p_argc p_argv
p <- fromIntegral `fmap` peek p_argc
argv <- peek p_argv
P.map packCString `fmap` peekArray (p - 1) (advancePtr argv 1)
#else
getArgs = do
stringArgs <- System.Environment.getArgs
return $ List.map (packWith c2w) stringArgs
#endif
-- ---------------------------------------------------------------------
-- Internal utilities
-- | Perform an operation with a temporary ByteString
withPtr :: ForeignPtr a -> (Ptr a -> IO b) -> b
withPtr fp io = inlinePerformIO (withForeignPtr fp io)
{-# INLINE withPtr #-}
-- Common up near identical calls to `error' to reduce the number
-- constant strings created when compiled:
errorEmptyList :: String -> a
errorEmptyList fun = moduleError fun "empty ByteString"
{-# NOINLINE errorEmptyList #-}
moduleError :: String -> String -> a
moduleError fun msg = error ("Data.ByteString." ++ fun ++ ':':' ':msg)
{-# NOINLINE moduleError #-}
-- Find from the end of the string using predicate
findFromEndUntil :: (Word8 -> Bool) -> ByteString -> Int
STRICT2(findFromEndUntil)
findFromEndUntil f ps@(PS x s l) =
if null ps then 0
else if f (last ps) then l
else findFromEndUntil f (PS x s (l-1))
{-# INLINE newForeignFreePtr #-}
newForeignFreePtr :: Ptr Word8 -> IO (ForeignPtr Word8)
#if defined(__GLASGOW_HASKELL__)
newForeignFreePtr p = FC.newForeignPtr p (c_free p)
#else
newForeignFreePtr p = newForeignPtr c_free_finalizer p
#endif