Data/ByteString.hs

   1 {-# OPTIONS_GHC -cpp -fglasgow-exts -fno-warn-orphans #-}
   2 --
   3 -- Module      : ByteString
   4 -- Copyright   : (c) The University of Glasgow 2001,
   5 --               (c) David Roundy 2003-2005,
   6 --               (c) Simon Marlow 2005
   7 --               (c) Don Stewart 2005-2006
   8 --               (c) Bjorn Bringert 2006
   9 --
  10 -- Array fusion code:
  11 --               (c) 2001,2002 Manuel M T Chakravarty & Gabriele Keller
  12 --               (c) 2006      Manuel M T Chakravarty & Roman Leshchinskiy
  13 --
  14 -- License     : BSD-style
  15 --
  16 -- Maintainer  : dons@cse.unsw.edu.au
  17 -- Stability   : experimental
  18 -- Portability : portable, requires ffi and cpp
  19 -- Tested with : GHC 6.4.1 and Hugs March 2005
  20 --
  21
  22 --
  23 -- | A time and space-efficient implementation of byte vectors using
  24 -- packed Word8 arrays, suitable for high performance use, both in terms
  25 -- of large data quantities, or high speed requirements. Byte vectors
  26 -- are encoded as strict 'Word8' arrays of bytes, held in a 'ForeignPtr',
  27 -- and can be passed between C and Haskell with little effort.
  28 --
  29 -- This module is intended to be imported @qualified@, to avoid name
  30 -- clashes with "Prelude" functions.  eg.
  31 --
  32 -- > import qualified Data.ByteString as B
  33 --
  34 -- Original GHC implementation by Bryan O\'Sullivan. Rewritten to use
  35 -- UArray by Simon Marlow. Rewritten to support slices and use
  36 -- ForeignPtr by David Roundy. Polished and extended by Don Stewart.
  37 --
  38
  39 module Data.ByteString (
  40
  41         -- * The @ByteString@ type
  42         ByteString,             -- abstract, instances: Eq, Ord, Show, Read, Data, Typeable, Monoid
  43
  44         -- * Introducing and eliminating 'ByteString's
  45         empty,                  -- :: ByteString
  46         singleton,              -- :: Word8   -> ByteString
  47         pack,                   -- :: [Word8] -> ByteString
  48         unpack,                 -- :: ByteString -> [Word8]
  49
  50         -- * Basic interface
  51         cons,                   -- :: Word8 -> ByteString -> ByteString
  52         snoc,                   -- :: ByteString -> Word8 -> ByteString
  53         append,                 -- :: ByteString -> ByteString -> ByteString
  54         head,                   -- :: ByteString -> Word8
  55         last,                   -- :: ByteString -> Word8
  56         tail,                   -- :: ByteString -> ByteString
  57         init,                   -- :: ByteString -> ByteString
  58         null,                   -- :: ByteString -> Bool
  59         length,                 -- :: ByteString -> Int
  60
  61         -- * Transformating ByteStrings
  62         map,                    -- :: (Word8 -> Word8) -> ByteString -> ByteString
  63         reverse,                -- :: ByteString -> ByteString
  64         intersperse,            -- :: Word8 -> ByteString -> ByteString
  65         transpose,              -- :: [ByteString] -> [ByteString]
  66
  67         -- * Reducing 'ByteString's (folds)
  68         foldl,                  -- :: (a -> Word8 -> a) -> a -> ByteString -> a
  69         foldl',                 -- :: (a -> Word8 -> a) -> a -> ByteString -> a
  70         foldl1,                 -- :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
  71         foldl1',                -- :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
  72
  73         foldr,                  -- :: (Word8 -> a -> a) -> a -> ByteString -> a
  74         foldr',                 -- :: (Word8 -> a -> a) -> a -> ByteString -> a
  75         foldr1,                 -- :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
  76         foldr1',                -- :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
  77
  78         -- ** Special folds
  79         concat,                 -- :: [ByteString] -> ByteString
  80         concatMap,              -- :: (Word8 -> ByteString) -> ByteString -> ByteString
  81         any,                    -- :: (Word8 -> Bool) -> ByteString -> Bool
  82         all,                    -- :: (Word8 -> Bool) -> ByteString -> Bool
  83         maximum,                -- :: ByteString -> Word8
  84         minimum,                -- :: ByteString -> Word8
  85
  86         -- * Building ByteStrings
  87         -- ** Scans
  88         scanl,                  -- :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
  89         scanl1,                 -- :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
  90         scanr,                  -- :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
  91         scanr1,                 -- :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
  92
  93         -- ** Accumulating maps
  94         mapAccumL,              -- :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)
  95         mapAccumR,              -- :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)
  96         mapIndexed,             -- :: (Int -> Word8 -> Word8) -> ByteString -> ByteString
  97
  98         -- ** Unfolding ByteStrings
  99         replicate,              -- :: Int -> Word8 -> ByteString
 100         unfoldr,                -- :: (a -> Maybe (Word8, a)) -> a -> ByteString
 101         unfoldrN,               -- :: Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
 102
 103         -- * Substrings
 104
 105         -- ** Breaking strings
 106         take,                   -- :: Int -> ByteString -> ByteString
 107         drop,                   -- :: Int -> ByteString -> ByteString
 108         splitAt,                -- :: Int -> ByteString -> (ByteString, ByteString)
 109         takeWhile,              -- :: (Word8 -> Bool) -> ByteString -> ByteString
 110         dropWhile,              -- :: (Word8 -> Bool) -> ByteString -> ByteString
 111         span,                   -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
 112         spanEnd,                -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
 113         break,                  -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
 114         breakEnd,               -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
 115         group,                  -- :: ByteString -> [ByteString]
 116         groupBy,                -- :: (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString]
 117         inits,                  -- :: ByteString -> [ByteString]
 118         tails,                  -- :: ByteString -> [ByteString]
 119
 120         -- ** Breaking into many substrings
 121         split,                  -- :: Word8 -> ByteString -> [ByteString]
 122         splitWith,              -- :: (Word8 -> Bool) -> ByteString -> [ByteString]
 123
 124         -- ** Joining strings
 125         join,                   -- :: ByteString -> [ByteString] -> ByteString
 126
 127         -- * Predicates
 128         isPrefixOf,             -- :: ByteString -> ByteString -> Bool
 129         isSuffixOf,             -- :: ByteString -> ByteString -> Bool
 130
 131         -- ** Search for arbitrary substrings
 132         isSubstringOf,          -- :: ByteString -> ByteString -> Bool
 133         findSubstring,          -- :: ByteString -> ByteString -> Maybe Int
 134         findSubstrings,         -- :: ByteString -> ByteString -> [Int]
 135
 136         -- * Searching ByteStrings
 137
 138         -- ** Searching by equality
 139         -- | These functions use memchr(3) to efficiently search the ByteString
 140         elem,                   -- :: Word8 -> ByteString -> Bool
 141         notElem,                -- :: Word8 -> ByteString -> Bool
 142
 143         -- ** Searching with a predicate
 144         find,                   -- :: (Word8 -> Bool) -> ByteString -> Maybe Word8
 145         filter,                 -- :: (Word8 -> Bool) -> ByteString -> ByteString
 146 --      partition               -- :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
 147
 148         -- * Indexing ByteStrings
 149         index,                  -- :: ByteString -> Int -> Word8
 150         elemIndex,              -- :: Word8 -> ByteString -> Maybe Int
 151         elemIndices,            -- :: Word8 -> ByteString -> [Int]
 152         elemIndexEnd,           -- :: Word8 -> ByteString -> Maybe Int
 153         findIndex,              -- :: (Word8 -> Bool) -> ByteString -> Maybe Int
 154         findIndices,            -- :: (Word8 -> Bool) -> ByteString -> [Int]
 155         count,                  -- :: Word8 -> ByteString -> Int
 156
 157         -- * Zipping and unzipping ByteStrings
 158         zip,                    -- :: ByteString -> ByteString -> [(Word8,Word8)]
 159         zipWith,                -- :: (Word8 -> Word8 -> c) -> ByteString -> ByteString -> [c]
 160         unzip,                  -- :: [(Word8,Word8)] -> (ByteString,ByteString)
 161
 162         -- * Ordered ByteStrings
 163         sort,                   -- :: ByteString -> ByteString
 164
 165         -- * Low level CString conversions
 166
 167         -- ** Packing CStrings and pointers
 168         packCString,            -- :: CString -> ByteString
 169         packCStringLen,         -- :: CString -> ByteString
 170         packMallocCString,      -- :: CString -> ByteString
 171
 172         -- ** Using ByteStrings as CStrings
 173         useAsCString,           -- :: ByteString -> (CString -> IO a) -> IO a
 174         useAsCStringLen,        -- :: ByteString -> (CStringLen -> IO a) -> IO a
 175
 176         -- ** Copying ByteStrings
 177         -- | These functions perform memcpy(3) operations
 178         copy,                   -- :: ByteString -> ByteString
 179         copyCString,            -- :: CString -> IO ByteString
 180         copyCStringLen,         -- :: CStringLen -> IO ByteString
 181
 182         -- * I\/O with 'ByteString's
 183
 184         -- ** Standard input and output
 185         getLine,                -- :: IO ByteString
 186         getContents,            -- :: IO ByteString
 187         putStr,                 -- :: ByteString -> IO ()
 188         putStrLn,               -- :: ByteString -> IO ()
 189         interact,               -- :: (ByteString -> ByteString) -> IO ()
 190
 191         -- ** Files
 192         readFile,               -- :: FilePath -> IO ByteString
 193         writeFile,              -- :: FilePath -> ByteString -> IO ()
 194         appendFile,             -- :: FilePath -> ByteString -> IO ()
 195 --      mmapFile,               -- :: FilePath -> IO ByteString
 196
 197         -- ** I\/O with Handles
 198         hGetLine,               -- :: Handle -> IO ByteString
 199         hGetContents,           -- :: Handle -> IO ByteString
 200         hGet,                   -- :: Handle -> Int -> IO ByteString
 201         hGetNonBlocking,        -- :: Handle -> Int -> IO ByteString
 202         hPut,                   -- :: Handle -> ByteString -> IO ()
 203         hPutStr,                -- :: Handle -> ByteString -> IO ()
 204         hPutStrLn,              -- :: Handle -> ByteString -> IO ()
 205
 206 #if defined(__GLASGOW_HASKELL__)
 207         -- * Fusion utilities
 208         unpackList, -- eek, otherwise it gets thrown away by the simplifier
 209         lengthU, maximumU, minimumU
 210 #endif
 211
 212   ) where
 213
 214 import qualified Prelude as P
 215 import Prelude hiding           (reverse,head,tail,last,init,null
 216                                 ,length,map,lines,foldl,foldr,unlines
 217                                 ,concat,any,take,drop,splitAt,takeWhile
 218                                 ,dropWhile,span,break,elem,filter,maximum
 219                                 ,minimum,all,concatMap,foldl1,foldr1
 220                                 ,scanl,scanl1,scanr,scanr1
 221                                 ,readFile,writeFile,appendFile,replicate
 222                                 ,getContents,getLine,putStr,putStrLn,interact
 223                                 ,zip,zipWith,unzip,notElem)
 224
 225 import Data.ByteString.Base
 226 import Data.ByteString.Fusion
 227
 228 import qualified Data.List as List
 229
 230 import Data.Word                (Word8)
 231 import Data.Maybe               (listToMaybe)
 232 import Data.Array               (listArray)
 233 import qualified Data.Array as Array ((!))
 234
 235 -- Control.Exception.bracket not available in yhc or nhc
 236 import Control.Exception        (bracket, assert)
 237 import qualified Control.Exception as Exception
 238 import Control.Monad            (when)
 239
 240 import Foreign.C.String         (CString, CStringLen)
 241 import Foreign.C.Types          (CSize)
 242 import Foreign.ForeignPtr
 243 import Foreign.Marshal.Array
 244 import Foreign.Ptr
 245 import Foreign.Storable         (Storable(..))
 246
 247 -- hGetBuf and hPutBuf not available in yhc or nhc
 248 import System.IO                (stdin,stdout,hClose,hFileSize
 249                                 ,hGetBuf,hPutBuf,openBinaryFile
 250                                 ,Handle,IOMode(..))
 251
 252 import Data.Monoid              (Monoid, mempty, mappend, mconcat)
 253
 254 #if !defined(__GLASGOW_HASKELL__)
 255 import System.IO.Unsafe
 256 import qualified System.Environment
 257 import qualified System.IO      (hGetLine)
 258 #endif
 259
 260 #if defined(__GLASGOW_HASKELL__)
 261
 262 import System.IO                (hGetBufNonBlocking)
 263 import System.IO.Error          (isEOFError)
 264
 265 import GHC.Handle
 266 import GHC.Prim                 (Word#, (+#), writeWord8OffAddr#)
 267 import GHC.Base                 (build)
 268 import GHC.Word hiding (Word8)
 269 import GHC.Ptr                  (Ptr(..))
 270 import GHC.ST                   (ST(..))
 271 import GHC.IOBase
 272
 273 #endif
 274
 275 -- -----------------------------------------------------------------------------
 276 --
 277 -- Useful macros, until we have bang patterns
 278 --
 279
 280 #define STRICT1(f) f a | a `seq` False = undefined
 281 #define STRICT2(f) f a b | a `seq` b `seq` False = undefined
 282 #define STRICT3(f) f a b c | a `seq` b `seq` c `seq` False = undefined
 283 #define STRICT4(f) f a b c d | a `seq` b `seq` c `seq` d `seq` False = undefined
 284 #define STRICT5(f) f a b c d e | a `seq` b `seq` c `seq` d `seq` e `seq` False = undefined
 285
 286 -- -----------------------------------------------------------------------------
 287
 288 instance Eq  ByteString
 289     where (==)    = eq
 290
 291 instance Ord ByteString
 292     where compare = compareBytes
 293
 294 instance Show ByteString where
 295     showsPrec p ps r = showsPrec p (unpackWith w2c ps) r
 296
 297 instance Read ByteString where
 298     readsPrec p str = [ (packWith c2w x, y) | (x, y) <- readsPrec p str ]
 299
 300 instance Monoid ByteString where
 301     mempty  = empty
 302     mappend = append
 303     mconcat = concat
 304
 305 {-
 306 instance Arbitrary PackedString where
 307     arbitrary = P.pack `fmap` arbitrary
 308     coarbitrary s = coarbitrary (P.unpack s)
 309 -}
 310
 311 -- | /O(n)/ Equality on the 'ByteString' type.
 312 eq :: ByteString -> ByteString -> Bool
 313 eq a@(PS p s l) b@(PS p' s' l')
 314     | l /= l'            = False    -- short cut on length
 315     | p == p' && s == s' = True     -- short cut for the same string
 316     | otherwise          = compareBytes a b == EQ
 317 {-# INLINE eq #-}
 318
 319 -- | /O(n)/ 'compareBytes' provides an 'Ordering' for 'ByteStrings' supporting slices.
 320 compareBytes :: ByteString -> ByteString -> Ordering
 321 compareBytes (PS x1 s1 l1) (PS x2 s2 l2)
 322     | l1 == 0  && l2 == 0               = EQ  -- short cut for empty strings
 323     | x1 == x2 && s1 == s2 && l1 == l2  = EQ  -- short cut for the same string
 324     | otherwise                         = inlinePerformIO $
 325         withForeignPtr x1 $ \p1 ->
 326         withForeignPtr x2 $ \p2 -> do
 327             i <- memcmp (p1 `plusPtr` s1) (p2 `plusPtr` s2) (fromIntegral $ min l1 l2)
 328             return $! case i `compare` 0 of
 329                         EQ  -> l1 `compare` l2
 330                         x   -> x
 331 {-# INLINE compareBytes #-}
 332
 333 {-
 334 --
 335 -- About 4x slower over 32M
 336 --
 337 compareBytes :: ByteString -> ByteString -> Ordering
 338 compareBytes (PS fp1 off1 len1) (PS fp2 off2 len2) = inlinePerformIO $
 339     withForeignPtr fp1 $ \p1 ->
 340         withForeignPtr fp2 $ \p2 ->
 341             cmp (p1 `plusPtr` off1)
 342                 (p2 `plusPtr` off2) 0 len1 len2
 343
 344 cmp :: Ptr Word8 -> Ptr Word8 -> Int -> Int -> Int-> IO Ordering
 345 STRICT5(cmp)
 346 cmp p1 p2 n len1 len2
 347       | n == len1 = if n == len2 then return EQ else return LT
 348       | n == len2 = return GT
 349       | otherwise = do
 350           (a :: Word8) <- peekByteOff p1 n
 351           (b :: Word8) <- peekByteOff p2 n
 352           case a `compare` b of
 353                 EQ -> cmp p1 p2 (n+1) len1 len2
 354                 LT -> return LT
 355                 GT -> return GT
 356 {-# INLINE compareBytes #-}
 357 -}
 358
 359 -- -----------------------------------------------------------------------------
 360 -- Introducing and eliminating 'ByteString's
 361
 362 -- | /O(1)/ Convert a 'Word8' into a 'ByteString'
 363 singleton :: Word8 -> ByteString
 364 singleton c = unsafeCreate 1 $ \p -> poke p c
 365 {-# INLINE [1] singleton #-}
 366
 367 --
 368 -- XXX The unsafePerformIO is critical!
 369 --
 370 -- Otherwise:
 371 --
 372 --  singleton 255 `compare` singleton 127
 373 --
 374 -- is compiled to:
 375 --
 376 --  case mallocByteString 2 of
 377 --      ForeignPtr f internals ->
 378 --           case writeWord8OffAddr# f 0 255 of _ ->
 379 --           case writeWord8OffAddr# f 0 127 of _ ->
 380 --           case eqAddr# f f of
 381 --                  False -> case compare (GHC.Prim.plusAddr# f 0)
 382 --                                        (GHC.Prim.plusAddr# f 0)
 383 --
 384 --
 385
 386 -- | /O(n)/ Convert a '[Word8]' into a 'ByteString'.
 387 --
 388 -- For applications with large numbers of string literals, pack can be a
 389 -- bottleneck. In such cases, consider using packAddress (GHC only).
 390 pack :: [Word8] -> ByteString
 391
 392 #if !defined(__GLASGOW_HASKELL__)
 393
 394 pack str = unsafeCreate (P.length str) $ \p -> go p str
 395     where
 396         go _ []     = return ()
 397         go p (x:xs) = poke p x >> go (p `plusPtr` 1) xs -- less space than pokeElemOff
 398
 399 #else /* hack away */
 400
 401 pack str = unsafeCreate (P.length str) $ \(Ptr p) -> stToIO (go p 0# str)
 402     where
 403         go _ _ []        = return ()
 404         go p i (W8# c:cs) = writeByte p i c >> go p (i +# 1#) cs
 405
 406         writeByte p i c = ST $ \s# ->
 407             case writeWord8OffAddr# p i c s# of s2# -> (# s2#, () #)
 408
 409 #endif
 410
 411 -- | /O(n)/ Converts a 'ByteString' to a '[Word8]'.
 412 unpack :: ByteString -> [Word8]
 413
 414 #if !defined(__GLASGOW_HASKELL__)
 415
 416 unpack (PS _  _ 0) = []
 417 unpack (PS ps s l) = inlinePerformIO $ withForeignPtr ps $ \p ->
 418         go (p `plusPtr` s) (l - 1) []
 419     where
 420         STRICT3(go)
 421         go p 0 acc = peek p          >>= \e -> return (e : acc)
 422         go p n acc = peekByteOff p n >>= \e -> go p (n-1) (e : acc)
 423 {-# INLINE unpack #-}
 424
 425 #else
 426
 427 unpack ps = build (unpackFoldr ps)
 428 {-# INLINE unpack #-}
 429
 430 --
 431 -- critical this isn't strict in the acc
 432 -- as it will break in the presence of list fusion. this is a known
 433 -- issue with seq and build/foldr rewrite rules, which rely on lazy
 434 -- demanding to avoid bottoms in the list.
 435 --
 436 unpackFoldr :: ByteString -> (Word8 -> a -> a) -> a -> a
 437 unpackFoldr (PS fp off len) f ch = withPtr fp $ \p -> do
 438     let loop q n    _   | q `seq` n `seq` False = undefined -- n.b.
 439         loop _ (-1) acc = return acc
 440         loop q n    acc = do
 441            a <- peekByteOff q n
 442            loop q (n-1) (a `f` acc)
 443     loop (p `plusPtr` off) (len-1) ch
 444 {-# INLINE [0] unpackFoldr #-}
 445
 446 unpackList :: ByteString -> [Word8]
 447 unpackList (PS fp off len) = withPtr fp $ \p -> do
 448     let STRICT3(loop)
 449         loop _ (-1) acc = return acc
 450         loop q n acc = do
 451            a <- peekByteOff q n
 452            loop q (n-1) (a : acc)
 453     loop (p `plusPtr` off) (len-1) []
 454
 455 {-# RULES
 456 "unpack-list"  [1]  forall p  . unpackFoldr p (:) [] = unpackList p
 457  #-}
 458
 459 #endif
 460
 461 ------------------------------------------------------------------------
 462
 463 -- | /O(n)/ Convert a '[a]' into a 'ByteString' using some
 464 -- conversion function
 465 packWith :: (a -> Word8) -> [a] -> ByteString
 466 packWith k str = unsafeCreate (P.length str) $ \p -> go p str
 467     where
 468         STRICT2(go)
 469         go _ []     = return ()
 470         go p (x:xs) = poke p (k x) >> go (p `plusPtr` 1) xs -- less space than pokeElemOff
 471 {-# INLINE packWith #-}
 472 {-# SPECIALIZE packWith :: (Char -> Word8) -> [Char] -> ByteString #-}
 473
 474 -- | /O(n)/ Converts a 'ByteString' to a '[a]', using a conversion function.
 475 unpackWith :: (Word8 -> a) -> ByteString -> [a]
 476 unpackWith _ (PS _  _ 0) = []
 477 unpackWith k (PS ps s l) = inlinePerformIO $ withForeignPtr ps $ \p ->
 478         go (p `plusPtr` s) (l - 1) []
 479     where
 480         STRICT3(go)
 481         go p 0 acc = peek p          >>= \e -> return (k e : acc)
 482         go p n acc = peekByteOff p n >>= \e -> go p (n-1) (k e : acc)
 483 {-# INLINE unpackWith #-}
 484 {-# SPECIALIZE unpackWith :: (Word8 -> Char) -> ByteString -> [Char] #-}
 485
 486 -- ---------------------------------------------------------------------
 487 -- Basic interface
 488
 489 -- | /O(1)/ Test whether a ByteString is empty.
 490 null :: ByteString -> Bool
 491 null (PS _ _ l) = assert (l >= 0) $ l <= 0
 492 {-# INLINE null #-}
 493
 494 -- ---------------------------------------------------------------------
 495 -- | /O(1)/ 'length' returns the length of a ByteString as an 'Int'.
 496 length :: ByteString -> Int
 497 length (PS _ _ l) = assert (l >= 0) $ l
 498
 499 --
 500 -- length/loop fusion. When taking the length of any fuseable loop,
 501 -- rewrite it as a foldl', and thus avoid allocating the result buffer
 502 -- worth around 10% in speed testing.
 503 --
 504
 505 #if defined(__GLASGOW_HASKELL__)
 506 {-# INLINE [1] length #-}
 507 #endif
 508
 509 lengthU :: ByteString -> Int
 510 lengthU = foldl' (const . (+1)) (0::Int)
 511 {-# INLINE lengthU #-}
 512
 513 {-# RULES
 514
 515 -- v2 fusion
 516 "length/loop" forall loop s .
 517   length  (loopArr (loopWrapper loop s)) =
 518   lengthU (loopArr (loopWrapper loop s))
 519
 520   #-}
 521
 522 ------------------------------------------------------------------------
 523
 524 -- | /O(n)/ 'cons' is analogous to (:) for lists, but of different
 525 -- complexity, as it requires a memcpy.
 526 cons :: Word8 -> ByteString -> ByteString
 527 cons c (PS x s l) = unsafeCreate (l+1) $ \p -> withForeignPtr x $ \f -> do
 528         poke p c
 529         memcpy (p `plusPtr` 1) (f `plusPtr` s) (fromIntegral l)
 530 {-# INLINE cons #-}
 531
 532 -- | /O(n)/ Append a byte to the end of a 'ByteString'
 533 snoc :: ByteString -> Word8 -> ByteString
 534 snoc (PS x s l) c = unsafeCreate (l+1) $ \p -> withForeignPtr x $ \f -> do
 535         memcpy p (f `plusPtr` s) (fromIntegral l)
 536         poke (p `plusPtr` l) c
 537 {-# INLINE snoc #-}
 538
 539 -- todo fuse
 540
 541 -- | /O(1)/ Extract the first element of a ByteString, which must be non-empty.
 542 -- An exception will be thrown in the case of an empty ByteString.
 543 head :: ByteString -> Word8
 544 head (PS x s l)
 545     | l <= 0    = errorEmptyList "head"
 546     | otherwise = inlinePerformIO $ withForeignPtr x $ \p -> peekByteOff p s
 547 {-# INLINE head #-}
 548
 549 -- | /O(1)/ Extract the elements after the head of a ByteString, which must be non-empty.
 550 -- An exception will be thrown in the case of an empty ByteString.
 551 tail :: ByteString -> ByteString
 552 tail (PS p s l)
 553     | l <= 0    = errorEmptyList "tail"
 554     | otherwise = PS p (s+1) (l-1)
 555 {-# INLINE tail #-}
 556
 557 -- | /O(1)/ Extract the last element of a ByteString, which must be finite and non-empty.
 558 -- An exception will be thrown in the case of an empty ByteString.
 559 last :: ByteString -> Word8
 560 last ps@(PS x s l)
 561     | null ps   = errorEmptyList "last"
 562     | otherwise = inlinePerformIO $ withForeignPtr x $ \p -> peekByteOff p (s+l-1)
 563 {-# INLINE last #-}
 564
 565 -- | /O(1)/ Return all the elements of a 'ByteString' except the last one.
 566 -- An exception will be thrown in the case of an empty ByteString.
 567 init :: ByteString -> ByteString
 568 init ps@(PS p s l)
 569     | null ps   = errorEmptyList "init"
 570     | otherwise = PS p s (l-1)
 571 {-# INLINE init #-}
 572
 573 -- | /O(n)/ Append two ByteStrings
 574 append :: ByteString -> ByteString -> ByteString
 575 append xs ys | null xs   = ys
 576              | null ys   = xs
 577              | otherwise = concat [xs,ys]
 578 {-# INLINE append #-}
 579
 580 -- ---------------------------------------------------------------------
 581 -- Transformations
 582
 583 -- | /O(n)/ 'map' @f xs@ is the ByteString obtained by applying @f@ to each
 584 -- element of @xs@. This function is subject to array fusion.
 585 map :: (Word8 -> Word8) -> ByteString -> ByteString
 586 #if defined(LOOPU_FUSION)
 587 map f = loopArr . loopU (mapEFL f) NoAcc
 588 #elif defined(LOOPUP_FUSION)
 589 map f = loopArr . loopUp (mapEFL f) NoAcc
 590 #elif defined(LOOPNOACC_FUSION)
 591 map f = loopArr . loopNoAcc (mapEFL f)
 592 #else
 593 map f = loopArr . loopMap f
 594 #endif
 595 {-# INLINE map #-}
 596
 597 {-
 598 -- | /O(n)/ Like 'map', but not fuseable. The benefit is that it is
 599 -- slightly faster for one-shot cases.
 600 map' :: (Word8 -> Word8) -> ByteString -> ByteString
 601 map' f (PS fp s len) = inlinePerformIO $ withForeignPtr fp $ \a ->
 602     create len $ map_ 0 (a `plusPtr` s)
 603   where
 604     map_ :: Int -> Ptr Word8 -> Ptr Word8 -> IO ()
 605     STRICT3(map_)
 606     map_ n p1 p2
 607        | n >= len = return ()
 608        | otherwise = do
 609             x <- peekByteOff p1 n
 610             pokeByteOff p2 n (f x)
 611             map_ (n+1) p1 p2
 612 {-# INLINE map' #-}
 613 -}
 614
 615 -- | /O(n)/ 'reverse' @xs@ efficiently returns the elements of @xs@ in reverse order.
 616 reverse :: ByteString -> ByteString
 617 reverse (PS x s l) = unsafeCreate l $ \p -> withForeignPtr x $ \f ->
 618         c_reverse p (f `plusPtr` s) (fromIntegral l)
 619
 620 -- todo, fuseable version
 621
 622 -- | /O(n)/ The 'intersperse' function takes a 'Word8' and a
 623 -- 'ByteString' and \`intersperses\' that byte between the elements of
 624 -- the 'ByteString'.  It is analogous to the intersperse function on
 625 -- Lists.
 626 intersperse :: Word8 -> ByteString -> ByteString
 627 intersperse c ps@(PS x s l)
 628     | length ps < 2  = ps
 629     | otherwise      = unsafeCreate (2*l-1) $ \p -> withForeignPtr x $ \f ->
 630         c_intersperse p (f `plusPtr` s) (fromIntegral l) c
 631
 632 {-
 633 intersperse c = pack . List.intersperse c . unpack
 634 -}
 635
 636 -- | The 'transpose' function transposes the rows and columns of its
 637 -- 'ByteString' argument.
 638 transpose :: [ByteString] -> [ByteString]
 639 transpose ps = P.map pack (List.transpose (P.map unpack ps))
 640
 641 -- ---------------------------------------------------------------------
 642 -- Reducing 'ByteString's
 643
 644 -- | 'foldl', applied to a binary operator, a starting value (typically
 645 -- the left-identity of the operator), and a ByteString, reduces the
 646 -- ByteString using the binary operator, from left to right.
 647 -- This function is subject to array fusion.
 648 foldl :: (a -> Word8 -> a) -> a -> ByteString -> a
 649 #if !defined(LOOPU_FUSION)
 650 foldl f z = loopAcc . loopUp (foldEFL f) z
 651 #else
 652 foldl f z = loopAcc . loopU (foldEFL f) z
 653 #endif
 654 {-# INLINE foldl #-}
 655
 656 {-
 657 --
 658 -- About twice as fast with 6.4.1, but not fuseable
 659 -- A simple fold . map is enough to make it worth while.
 660 --
 661 foldl f v (PS x s l) = inlinePerformIO $ withForeignPtr x $ \ptr ->
 662         lgo v (ptr `plusPtr` s) (ptr `plusPtr` (s+l))
 663     where
 664         STRICT3(lgo)
 665         lgo z p q | p == q    = return z
 666                   | otherwise = do c <- peek p
 667                                    lgo (f z c) (p `plusPtr` 1) q
 668 -}
 669
 670 -- | 'foldl\'' is like 'foldl', but strict in the accumulator.
 671 -- Though actually foldl is also strict in the accumulator.
 672 foldl' :: (a -> Word8 -> a) -> a -> ByteString -> a
 673 foldl' = foldl
 674 -- foldl' f z = loopAcc . loopU (foldEFL' f) z
 675 {-# INLINE foldl' #-}
 676
 677 -- | 'foldr', applied to a binary operator, a starting value
 678 -- (typically the right-identity of the operator), and a ByteString,
 679 -- reduces the ByteString using the binary operator, from right to left.
 680 foldr :: (Word8 -> a -> a) -> a -> ByteString -> a
 681 foldr k z = loopAcc . loopDown (foldEFL (flip k)) z
 682 {-# INLINE foldr #-}
 683
 684 -- | 'foldr\'' is like 'foldr', but strict in the accumulator.
 685 foldr' :: (Word8 -> a -> a) -> a -> ByteString -> a
 686 foldr' k v (PS x s l) = inlinePerformIO $ withForeignPtr x $ \ptr ->
 687         go v (ptr `plusPtr` (s+l-1)) (ptr `plusPtr` (s-1))
 688     where
 689         STRICT3(go)
 690         go z p q | p == q    = return z
 691                  | otherwise = do c  <- peek p
 692                                   go (c `k` z) (p `plusPtr` (-1)) q -- tail recursive
 693 {-# INLINE [1] foldr' #-}
 694
 695 -- | 'foldl1' is a variant of 'foldl' that has no starting value
 696 -- argument, and thus must be applied to non-empty 'ByteStrings'.
 697 -- This function is subject to array fusion.
 698 -- An exception will be thrown in the case of an empty ByteString.
 699 foldl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
 700 foldl1 f ps
 701     | null ps   = errorEmptyList "foldl1"
 702     | otherwise = foldl f (unsafeHead ps) (unsafeTail ps)
 703 {-# INLINE foldl1 #-}
 704
 705 -- | 'foldl1\'' is like 'foldl1', but strict in the accumulator.
 706 -- An exception will be thrown in the case of an empty ByteString.
 707 foldl1' :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
 708 foldl1' f ps
 709     | null ps   = errorEmptyList "foldl1'"
 710     | otherwise = foldl' f (unsafeHead ps) (unsafeTail ps)
 711 {-# INLINE foldl1' #-}
 712
 713 -- | 'foldr1' is a variant of 'foldr' that has no starting value argument,
 714 -- and thus must be applied to non-empty 'ByteString's
 715 -- An exception will be thrown in the case of an empty ByteString.
 716 foldr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
 717 foldr1 f ps
 718     | null ps        = errorEmptyList "foldr1"
 719     | otherwise      = foldr f (last ps) (init ps)
 720 {-# INLINE foldr1 #-}
 721
 722 -- | 'foldr1\'' is a variant of 'foldr1', but is strict in the
 723 -- accumulator.
 724 foldr1' :: (Word8 -> Word8 -> Word8) -> ByteString -> Word8
 725 foldr1' f ps
 726     | null ps        = errorEmptyList "foldr1"
 727     | otherwise      = foldr' f (last ps) (init ps)
 728 {-# INLINE [1] foldr1' #-}
 729
 730 -- ---------------------------------------------------------------------
 731 -- Special folds
 732
 733 -- | /O(n)/ Concatenate a list of ByteStrings.
 734 concat :: [ByteString] -> ByteString
 735 concat []     = empty
 736 concat [ps]   = ps
 737 concat xs     = unsafeCreate len $ \ptr -> go xs ptr
 738   where len = P.sum . P.map length $ xs
 739         STRICT2(go)
 740         go []            _   = return ()
 741         go (PS p s l:ps) ptr = do
 742                 withForeignPtr p $ \fp -> memcpy ptr (fp `plusPtr` s) (fromIntegral l)
 743                 go ps (ptr `plusPtr` l)
 744
 745 -- | Map a function over a 'ByteString' and concatenate the results
 746 concatMap :: (Word8 -> ByteString) -> ByteString -> ByteString
 747 concatMap f = concat . foldr ((:) . f) []
 748
 749 -- foldr (append . f) empty
 750
 751 -- | /O(n)/ Applied to a predicate and a ByteString, 'any' determines if
 752 -- any element of the 'ByteString' satisfies the predicate.
 753 any :: (Word8 -> Bool) -> ByteString -> Bool
 754 any _ (PS _ _ 0) = False
 755 any f (PS x s l) = inlinePerformIO $ withForeignPtr x $ \ptr ->
 756         go (ptr `plusPtr` s) (ptr `plusPtr` (s+l))
 757     where
 758         STRICT2(go)
 759         go p q | p == q    = return False
 760                | otherwise = do c <- peek p
 761                                 if f c then return True
 762                                        else go (p `plusPtr` 1) q
 763
 764 -- todo fuse
 765
 766 -- | /O(n)/ Applied to a predicate and a 'ByteString', 'all' determines
 767 -- if all elements of the 'ByteString' satisfy the predicate.
 768 all :: (Word8 -> Bool) -> ByteString -> Bool
 769 all _ (PS _ _ 0) = True
 770 all f (PS x s l) = inlinePerformIO $ withForeignPtr x $ \ptr ->
 771         go (ptr `plusPtr` s) (ptr `plusPtr` (s+l))
 772     where
 773         STRICT2(go)
 774         go p q | p == q     = return True  -- end of list
 775                | otherwise  = do c <- peek p
 776                                  if f c
 777                                     then go (p `plusPtr` 1) q
 778                                     else return False
 779
 780 ------------------------------------------------------------------------
 781
 782 -- | /O(n)/ 'maximum' returns the maximum value from a 'ByteString'
 783 -- This function will fuse.
 784 -- An exception will be thrown in the case of an empty ByteString.
 785 maximum :: ByteString -> Word8
 786 maximum xs@(PS x s l)
 787     | null xs   = errorEmptyList "maximum"
 788     | otherwise = inlinePerformIO $ withForeignPtr x $ \p ->
 789                       c_maximum (p `plusPtr` s) (fromIntegral l)
 790
 791 -- | /O(n)/ 'minimum' returns the minimum value from a 'ByteString'
 792 -- This function will fuse.
 793 -- An exception will be thrown in the case of an empty ByteString.
 794 minimum :: ByteString -> Word8
 795 minimum xs@(PS x s l)
 796     | null xs   = errorEmptyList "minimum"
 797     | otherwise = inlinePerformIO $ withForeignPtr x $ \p ->
 798                       c_minimum (p `plusPtr` s) (fromIntegral l)
 799
 800 --
 801 -- minimum/maximum/loop fusion. As for length (and other folds), when we
 802 -- see we're applied after a fuseable op, switch from using the C
 803 -- version, to the fuseable version. The result should then avoid
 804 -- allocating a buffer.
 805 --
 806
 807 #if defined(__GLASGOW_HASKELL__)
 808 {-# INLINE [1] minimum #-}
 809 {-# INLINE [1] maximum #-}
 810 #endif
 811
 812 maximumU :: ByteString -> Word8
 813 maximumU = foldl1' max
 814 {-# INLINE maximumU #-}
 815
 816 minimumU :: ByteString -> Word8
 817 minimumU = foldl1' min
 818 {-# INLINE minimumU #-}
 819
 820 {-# RULES
 821
 822 "minimum/loop" forall loop s .
 823   minimum  (loopArr (loopWrapper loop s)) =
 824   minimumU (loopArr (loopWrapper loop s))
 825
 826 "maximum/loop" forall loop s .
 827   maximum  (loopArr (loopWrapper loop s)) =
 828   maximumU (loopArr (loopWrapper loop s))
 829
 830   #-}
 831
 832 ------------------------------------------------------------------------
 833
 834 -- | The 'mapAccumL' function behaves like a combination of 'map' and
 835 -- 'foldl'; it applies a function to each element of a ByteString,
 836 -- passing an accumulating parameter from left to right, and returning a
 837 -- final value of this accumulator together with the new list.
 838 mapAccumL :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)
 839 #if !defined(LOOPU_FUSION)
 840 mapAccumL f z = unSP . loopUp (mapAccumEFL f) z
 841 #else
 842 mapAccumL f z = unSP . loopU (mapAccumEFL f) z
 843 #endif
 844 {-# INLINE mapAccumL #-}
 845
 846 -- | The 'mapAccumR' function behaves like a combination of 'map' and
 847 -- 'foldr'; it applies a function to each element of a ByteString,
 848 -- passing an accumulating parameter from right to left, and returning a
 849 -- final value of this accumulator together with the new ByteString.
 850 mapAccumR :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)
 851 mapAccumR f z = unSP . loopDown (mapAccumEFL f) z
 852 {-# INLINE mapAccumR #-}
 853
 854 -- | /O(n)/ map Word8 functions, provided with the index at each position
 855 mapIndexed :: (Int -> Word8 -> Word8) -> ByteString -> ByteString
 856 mapIndexed f = loopArr . loopUp (mapIndexEFL f) 0
 857 {-# INLINE mapIndexed #-}
 858
 859 -- ---------------------------------------------------------------------
 860 -- Building ByteStrings
 861
 862 -- | 'scanl' is similar to 'foldl', but returns a list of successive
 863 -- reduced values from the left. This function will fuse.
 864 --
 865 -- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]
 866 --
 867 -- Note that
 868 --
 869 -- > last (scanl f z xs) == foldl f z xs.
 870 scanl :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
 871 #if !defined(LOOPU_FUSION)
 872 scanl f z ps = loopArr . loopUp (scanEFL f) z $ (ps `snoc` 0)
 873 #else
 874 scanl f z ps = loopArr . loopU (scanEFL f) z $ (ps `snoc` 0)
 875 #endif
 876
 877     -- n.b. haskell's List scan returns a list one bigger than the
 878     -- input, so we need to snoc here to get some extra space, however,
 879     -- it breaks map/up fusion (i.e. scanl . map no longer fuses)
 880 {-# INLINE scanl #-}
 881
 882 -- | 'scanl1' is a variant of 'scanl' that has no starting value argument.
 883 -- This function will fuse.
 884 --
 885 -- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
 886 scanl1 :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
 887 scanl1 f ps
 888     | null ps   = empty
 889     | otherwise = scanl f (unsafeHead ps) (unsafeTail ps)
 890 {-# INLINE scanl1 #-}
 891
 892 -- | scanr is the right-to-left dual of scanl.
 893 scanr :: (Word8 -> Word8 -> Word8) -> Word8 -> ByteString -> ByteString
 894 scanr f z ps = loopArr . loopDown (scanEFL (flip f)) z $ (0 `cons` ps) -- extra space
 895 {-# INLINE scanr #-}
 896
 897 -- | 'scanr1' is a variant of 'scanr' that has no starting value argument.
 898 scanr1 :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString
 899 scanr1 f ps
 900     | null ps   = empty
 901     | otherwise = scanr f (last ps) (init ps) -- todo, unsafe versions
 902 {-# INLINE scanr1 #-}
 903
 904 -- ---------------------------------------------------------------------
 905 -- Unfolds and replicates
 906
 907 -- | /O(n)/ 'replicate' @n x@ is a ByteString of length @n@ with @x@
 908 -- the value of every element. The following holds:
 909 --
 910 -- > replicate w c = unfoldr w (\u -> Just (u,u)) c
 911 --
 912 -- This implemenation uses @memset(3)@
 913 replicate :: Int -> Word8 -> ByteString
 914 replicate w c
 915     | w <= 0    = empty
 916     | otherwise = unsafeCreate w $ \ptr ->
 917                       memset ptr c (fromIntegral w) >> return ()
 918
 919 -- | /O(n)/, where /n/ is the length of the result.  The 'unfoldr'
 920 -- function is analogous to the List \'unfoldr\'.  'unfoldr' builds a
 921 -- ByteString from a seed value.  The function takes the element and
 922 -- returns 'Nothing' if it is done producing the ByteString or returns
 923 -- 'Just' @(a,b)@, in which case, @a@ is the next byte in the string,
 924 -- and @b@ is the seed value for further production.
 925 --
 926 -- Examples:
 927 --
 928 -- >    unfoldr (\x -> if x <= 5 then Just (x, x + 1) else Nothing) 0
 929 -- > == pack [0, 1, 2, 3, 4, 5]
 930 --
 931 unfoldr :: (a -> Maybe (Word8, a)) -> a -> ByteString
 932 unfoldr f = concat . unfoldChunk 32 64
 933   where unfoldChunk n n' x =
 934           case unfoldrN n f x of
 935             (s, Nothing) -> s : []
 936             (s, Just x') -> s : unfoldChunk n' (n+n') x'
 937
 938 -- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a ByteString from a seed
 939 -- value.  However, the length of the result is limited by the first
 940 -- argument to 'unfoldrN'.  This function is more efficient than 'unfoldr'
 941 -- when the maximum length of the result is known.
 942 --
 943 -- The following equation relates 'unfoldrN' and 'unfoldr':
 944 --
 945 -- > unfoldrN n f s == take n (unfoldr f s)
 946 --
 947 unfoldrN :: Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
 948 unfoldrN i f x0
 949     | i < 0     = (empty, Just x0)
 950     | otherwise = unsafePerformIO $ createAndTrim' i $ \p -> go p x0 0
 951   where STRICT3(go)
 952         go p x n =
 953           case f x of
 954             Nothing      -> return (0, n, Nothing)
 955             Just (w,x')
 956              | n == i    -> return (0, n, Just x)
 957              | otherwise -> do poke p w
 958                                go (p `plusPtr` 1) x' (n+1)
 959
 960 -- ---------------------------------------------------------------------
 961 -- Substrings
 962
 963 -- | /O(1)/ 'take' @n@, applied to a ByteString @xs@, returns the prefix
 964 -- of @xs@ of length @n@, or @xs@ itself if @n > 'length' xs@.
 965 take :: Int -> ByteString -> ByteString
 966 take n ps@(PS x s l)
 967     | n <= 0    = empty
 968     | n >= l    = ps
 969     | otherwise = PS x s n
 970 {-# INLINE take #-}
 971
 972 -- | /O(1)/ 'drop' @n xs@ returns the suffix of @xs@ after the first @n@
 973 -- elements, or @[]@ if @n > 'length' xs@.
 974 drop  :: Int -> ByteString -> ByteString
 975 drop n ps@(PS x s l)
 976     | n <= 0    = ps
 977     | n >= l    = empty
 978     | otherwise = PS x (s+n) (l-n)
 979 {-# INLINE drop #-}
 980
 981 -- | /O(1)/ 'splitAt' @n xs@ is equivalent to @('take' n xs, 'drop' n xs)@.
 982 splitAt :: Int -> ByteString -> (ByteString, ByteString)
 983 splitAt n ps@(PS x s l)
 984     | n <= 0    = (empty, ps)
 985     | n >= l    = (ps, empty)
 986     | otherwise = (PS x s n, PS x (s+n) (l-n))
 987 {-# INLINE splitAt #-}
 988
 989 -- | 'takeWhile', applied to a predicate @p@ and a ByteString @xs@,
 990 -- returns the longest prefix (possibly empty) of @xs@ of elements that
 991 -- satisfy @p@.
 992 takeWhile :: (Word8 -> Bool) -> ByteString -> ByteString
 993 takeWhile f ps = unsafeTake (findIndexOrEnd (not . f) ps) ps
 994 {-# INLINE takeWhile #-}
 995
 996 -- | 'dropWhile' @p xs@ returns the suffix remaining after 'takeWhile' @p xs@.
 997 dropWhile :: (Word8 -> Bool) -> ByteString -> ByteString
 998 dropWhile f ps = unsafeDrop (findIndexOrEnd (not . f) ps) ps
 999 {-# INLINE dropWhile #-}
1000
1001 -- | 'break' @p@ is equivalent to @'span' ('not' . p)@.
1002 break :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
1003 break p ps = case findIndexOrEnd p ps of n -> (unsafeTake n ps, unsafeDrop n ps)
1004 {-# INLINE [1] break #-}
1005
1006 {-# RULES
1007 "FPS specialise break (x==)" forall x.
1008     break ((==) x) = breakByte x
1009   #-}
1010
1011 #if __GLASGOW_HASKELL__ >= 605
1012 -- {-# RULES
1013 -- "FPS specialise break (==x)" forall x.
1014 --     break (==x) = breakByte x
1015 --   #-}
1016 #endif
1017
1018 -- | 'breakByte' breaks its ByteString argument at the first occurence
1019 -- of the specified byte. It is more efficient than 'break' as it is
1020 -- implemented with @memchr(3)@. I.e.
1021 --
1022 -- > break (=='c') "abcd" == breakByte 'c' "abcd"
1023 --
1024 breakByte :: Word8 -> ByteString -> (ByteString, ByteString)
1025 breakByte c p = case elemIndex c p of
1026     Nothing -> (p,empty)
1027     Just n  -> (unsafeTake n p, unsafeDrop n p)
1028 {-# INLINE breakByte #-}
1029
1030 -- | 'breakEnd' behaves like 'break' but from the end of the 'ByteString'
1031 --
1032 -- breakEnd p == spanEnd (not.p)
1033 breakEnd :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
1034 breakEnd  p ps = splitAt (findFromEndUntil p ps) ps
1035
1036 -- | 'span' @p xs@ breaks the ByteString into two segments. It is
1037 -- equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@
1038 span :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
1039 span p ps = break (not . p) ps
1040 {-# INLINE [1] span #-}
1041
1042 -- | 'spanByte' breaks its ByteString argument at the first
1043 -- occurence of a byte other than its argument. It is more efficient
1044 -- than 'span (==)'
1045 --
1046 -- > span  (=='c') "abcd" == spanByte 'c' "abcd"
1047 --
1048 spanByte :: Word8 -> ByteString -> (ByteString, ByteString)
1049 spanByte c ps@(PS x s l) = inlinePerformIO $ withForeignPtr x $ \p ->
1050     go (p `plusPtr` s) 0
1051   where
1052     STRICT2(go)
1053     go p i | i >= l    = return (ps, empty)
1054            | otherwise = do c' <- peekByteOff p i
1055                             if c /= c'
1056                                 then return (unsafeTake i ps, unsafeDrop i ps)
1057                                 else go p (i+1)
1058 {-# INLINE spanByte #-}
1059
1060 {-# RULES
1061 "FPS specialise span (x==)" forall x.
1062     span ((==) x) = spanByte x
1063   #-}
1064
1065 #if __GLASGOW_HASKELL__ >= 605
1066 -- {-# RULES
1067 -- "FPS specialise span (==x)" forall x.
1068 --     span (==x) = spanByte x
1069 --   #-}
1070 #endif
1071
1072 -- | 'spanEnd' behaves like 'span' but from the end of the 'ByteString'.
1073 -- We have
1074 --
1075 -- > spanEnd (not.isSpace) "x y z" == ("x y ","z")
1076 --
1077 -- and
1078 --
1079 -- > spanEnd (not . isSpace) ps
1080 -- >    ==
1081 -- > let (x,y) = span (not.isSpace) (reverse ps) in (reverse y, reverse x)
1082 --
1083 spanEnd :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
1084 spanEnd  p ps = splitAt (findFromEndUntil (not.p) ps) ps
1085
1086 -- | /O(n)/ Splits a 'ByteString' into components delimited by
1087 -- separators, where the predicate returns True for a separator element.
1088 -- The resulting components do not contain the separators.  Two adjacent
1089 -- separators result in an empty component in the output.  eg.
1090 --
1091 -- > splitWith (=='a') "aabbaca" == ["","","bb","c",""]
1092 -- > splitWith (=='a') []        == []
1093 --
1094 splitWith :: (Word8 -> Bool) -> ByteString -> [ByteString]
1095
1096 #if defined(__GLASGOW_HASKELL__)
1097 splitWith _pred (PS _  _   0) = []
1098 splitWith pred_ (PS fp off len) = splitWith0 pred# off len fp
1099   where pred# c# = pred_ (W8# c#)
1100
1101         STRICT4(splitWith0)
1102         splitWith0 pred' off' len' fp' = withPtr fp $ \p ->
1103             splitLoop pred' p 0 off' len' fp'
1104
1105         splitLoop :: (Word# -> Bool)
1106                   -> Ptr Word8
1107                   -> Int -> Int -> Int
1108                   -> ForeignPtr Word8
1109                   -> IO [ByteString]
1110
1111         splitLoop pred' p idx' off' len' fp'
1112             | pred' `seq` p `seq` idx' `seq` off' `seq` len' `seq` fp' `seq` False = undefined
1113             | idx' >= len'  = return [PS fp' off' idx']
1114             | otherwise = do
1115                 w <- peekElemOff p (off'+idx')
1116                 if pred' (case w of W8# w# -> w#)
1117                    then return (PS fp' off' idx' :
1118                               splitWith0 pred' (off'+idx'+1) (len'-idx'-1) fp')
1119                    else splitLoop pred' p (idx'+1) off' len' fp'
1120 {-# INLINE splitWith #-}
1121
1122 #else
1123 splitWith _ (PS _ _ 0) = []
1124 splitWith p ps = loop p ps
1125     where
1126         STRICT2(loop)
1127         loop q qs = if null rest then [chunk]
1128                                  else chunk : loop q (unsafeTail rest)
1129             where (chunk,rest) = break q qs
1130 #endif
1131
1132 -- | /O(n)/ Break a 'ByteString' into pieces separated by the byte
1133 -- argument, consuming the delimiter. I.e.
1134 --
1135 -- > split '\n' "a\nb\nd\ne" == ["a","b","d","e"]
1136 -- > split 'a'  "aXaXaXa"    == ["","X","X","X"]
1137 -- > split 'x'  "x"          == ["",""]
1138 --
1139 -- and
1140 --
1141 -- > join [c] . split c == id
1142 -- > split == splitWith . (==)
1143 --
1144 -- As for all splitting functions in this library, this function does
1145 -- not copy the substrings, it just constructs new 'ByteStrings' that
1146 -- are slices of the original.
1147 --
1148 split :: Word8 -> ByteString -> [ByteString]
1149 split _ (PS _ _ 0) = []
1150 split w (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> do
1151     let ptr = p `plusPtr` s
1152
1153         STRICT1(loop)
1154         loop n =
1155             let q = inlinePerformIO $ memchr (ptr `plusPtr` n)
1156                                            w (fromIntegral (l-n))
1157             in if q == nullPtr
1158                 then [PS x (s+n) (l-n)]
1159                 else let i = q `minusPtr` ptr in PS x (s+n) (i-n) : loop (i+1)
1160
1161     return (loop 0)
1162 {-# INLINE split #-}
1163
1164 {-
1165 -- slower. but stays inside Haskell.
1166 split _ (PS _  _   0) = []
1167 split (W8# w#) (PS fp off len) = splitWith' off len fp
1168     where
1169         splitWith' off' len' fp' = withPtr fp $ \p ->
1170             splitLoop p 0 off' len' fp'
1171
1172         splitLoop :: Ptr Word8
1173                   -> Int -> Int -> Int
1174                   -> ForeignPtr Word8
1175                   -> IO [ByteString]
1176
1177         STRICT5(splitLoop)
1178         splitLoop p idx' off' len' fp'
1179             | p `seq` idx' `seq` off' `seq` len' `seq` fp' `seq` False = undefined
1180             | idx' >= len'  = return [PS fp' off' idx']
1181             | otherwise = do
1182                 (W8# x#) <- peekElemOff p (off'+idx')
1183                 if word2Int# w# ==# word2Int# x#
1184                    then return (PS fp' off' idx' :
1185                               splitWith' (off'+idx'+1) (len'-idx'-1) fp')
1186                    else splitLoop p (idx'+1) off' len' fp'
1187 -}
1188
1189 {-
1190 -- | Like 'splitWith', except that sequences of adjacent separators are
1191 -- treated as a single separator. eg.
1192 --
1193 -- > tokens (=='a') "aabbaca" == ["bb","c"]
1194 --
1195 tokens :: (Word8 -> Bool) -> ByteString -> [ByteString]
1196 tokens f = P.filter (not.null) . splitWith f
1197 {-# INLINE tokens #-}
1198 -}
1199
1200 -- | The 'group' function takes a ByteString and returns a list of
1201 -- ByteStrings such that the concatenation of the result is equal to the
1202 -- argument.  Moreover, each sublist in the result contains only equal
1203 -- elements.  For example,
1204 --
1205 -- > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"]
1206 --
1207 -- It is a special case of 'groupBy', which allows the programmer to
1208 -- supply their own equality test. It is about 40% faster than
1209 -- /groupBy (==)/
1210 group :: ByteString -> [ByteString]
1211 group xs
1212     | null xs   = []
1213     | otherwise = ys : group zs
1214     where
1215         (ys, zs) = spanByte (unsafeHead xs) xs
1216
1217 -- | The 'groupBy' function is the non-overloaded version of 'group'.
1218 groupBy :: (Word8 -> Word8 -> Bool) -> ByteString -> [ByteString]
1219 groupBy k xs
1220     | null xs   = []
1221     | otherwise = unsafeTake n xs : groupBy k (unsafeDrop n xs)
1222     where
1223         n = 1 + findIndexOrEnd (not . k (unsafeHead xs)) (unsafeTail xs)
1224
1225 -- | /O(n)/ The 'join' function takes a 'ByteString' and a list of
1226 -- 'ByteString's and concatenates the list after interspersing the first
1227 -- argument between each element of the list.
1228 join :: ByteString -> [ByteString] -> ByteString
1229 join s = concat . (List.intersperse s)
1230 {-# INLINE [1] join #-}
1231
1232 {-# RULES
1233 "FPS specialise join c -> joinByte" forall c s1 s2 .
1234     join (singleton c) (s1 : s2 : []) = joinWithByte c s1 s2
1235   #-}
1236
1237 --
1238 -- | /O(n)/ joinWithByte. An efficient way to join to two ByteStrings
1239 -- with a char. Around 4 times faster than the generalised join.
1240 --
1241 joinWithByte :: Word8 -> ByteString -> ByteString -> ByteString
1242 joinWithByte c f@(PS ffp s l) g@(PS fgp t m) = unsafeCreate len $ \ptr ->
1243     withForeignPtr ffp $ \fp ->
1244     withForeignPtr fgp $ \gp -> do
1245         memcpy ptr (fp `plusPtr` s) (fromIntegral l)
1246         poke (ptr `plusPtr` l) c
1247         memcpy (ptr `plusPtr` (l + 1)) (gp `plusPtr` t) (fromIntegral m)
1248     where
1249       len = length f + length g + 1
1250 {-# INLINE joinWithByte #-}
1251
1252 -- ---------------------------------------------------------------------
1253 -- Indexing ByteStrings
1254
1255 -- | /O(1)/ 'ByteString' index (subscript) operator, starting from 0.
1256 index :: ByteString -> Int -> Word8
1257 index ps n
1258     | n < 0          = moduleError "index" ("negative index: " ++ show n)
1259     | n >= length ps = moduleError "index" ("index too large: " ++ show n
1260                                          ++ ", length = " ++ show (length ps))
1261     | otherwise      = ps `unsafeIndex` n
1262 {-# INLINE index #-}
1263
1264 -- | /O(n)/ The 'elemIndex' function returns the index of the first
1265 -- element in the given 'ByteString' which is equal to the query
1266 -- element, or 'Nothing' if there is no such element.
1267 -- This implementation uses memchr(3).
1268 elemIndex :: Word8 -> ByteString -> Maybe Int
1269 elemIndex c (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> do
1270     let p' = p `plusPtr` s
1271     q <- memchr p' c (fromIntegral l)
1272     return $! if q == nullPtr then Nothing else Just $! q `minusPtr` p'
1273 {-# INLINE elemIndex #-}
1274
1275 -- | /O(n)/ The 'elemIndexEnd' function returns the last index of the
1276 -- element in the given 'ByteString' which is equal to the query
1277 -- element, or 'Nothing' if there is no such element. The following
1278 -- holds:
1279 --
1280 -- > elemIndexEnd c xs ==
1281 -- > (-) (length xs - 1) `fmap` elemIndex c (reverse xs)
1282 --
1283 elemIndexEnd :: Word8 -> ByteString -> Maybe Int
1284 elemIndexEnd ch (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p ->
1285     go (p `plusPtr` s) (l-1)
1286   where
1287     STRICT2(go)
1288     go p i | i < 0     = return Nothing
1289            | otherwise = do ch' <- peekByteOff p i
1290                             if ch == ch'
1291                                 then return $ Just i
1292                                 else go p (i-1)
1293 {-# INLINE elemIndexEnd #-}
1294
1295 -- | /O(n)/ The 'elemIndices' function extends 'elemIndex', by returning
1296 -- the indices of all elements equal to the query element, in ascending order.
1297 -- This implementation uses memchr(3).
1298 elemIndices :: Word8 -> ByteString -> [Int]
1299 elemIndices w (PS x s l) = inlinePerformIO $ withForeignPtr x $ \p -> do
1300     let ptr = p `plusPtr` s
1301
1302         STRICT1(loop)
1303         loop n = let q = inlinePerformIO $ memchr (ptr `plusPtr` n)
1304                                                 w (fromIntegral (l - n))
1305                  in if q == nullPtr
1306                         then []
1307                         else let i = q `minusPtr` ptr
1308                              in i : loop (i+1)
1309     return $! loop 0
1310 {-# INLINE elemIndices #-}
1311
1312 {-
1313 -- much slower
1314 elemIndices :: Word8 -> ByteString -> [Int]
1315 elemIndices c ps = loop 0 ps
1316    where STRICT2(loop)
1317          loop _ ps' | null ps'            = []
1318          loop n ps' | c == unsafeHead ps' = n : loop (n+1) (unsafeTail ps')
1319                     | otherwise           = loop (n+1) (unsafeTail ps')
1320 -}
1321
1322 -- | count returns the number of times its argument appears in the ByteString
1323 --
1324 -- > count = length . elemIndices
1325 --
1326 -- But more efficiently than using length on the intermediate list.
1327 count :: Word8 -> ByteString -> Int
1328 count w (PS x s m) = inlinePerformIO $ withForeignPtr x $ \p ->
1329     fmap fromIntegral $ c_count (p `plusPtr` s) (fromIntegral m) w
1330 {-# INLINE count #-}
1331
1332 {-
1333 --
1334 -- around 30% slower
1335 --
1336 count w (PS x s m) = inlinePerformIO $ withForeignPtr x $ \p ->
1337      go (p `plusPtr` s) (fromIntegral m) 0
1338     where
1339         go :: Ptr Word8 -> CSize -> Int -> IO Int
1340         STRICT3(go)
1341         go p l i = do
1342             q <- memchr p w l
1343             if q == nullPtr
1344                 then return i
1345                 else do let k = fromIntegral $ q `minusPtr` p
1346                         go (q `plusPtr` 1) (l-k-1) (i+1)
1347 -}
1348
1349 -- | The 'findIndex' function takes a predicate and a 'ByteString' and
1350 -- returns the index of the first element in the ByteString
1351 -- satisfying the predicate.
1352 findIndex :: (Word8 -> Bool) -> ByteString -> Maybe Int
1353 findIndex k (PS x s l) = inlinePerformIO $ withForeignPtr x $ \f -> go (f `plusPtr` s) 0
1354   where
1355     STRICT2(go)
1356     go ptr n | n >= l    = return Nothing
1357              | otherwise = do w <- peek ptr
1358                               if k w
1359                                 then return (Just n)
1360                                 else go (ptr `plusPtr` 1) (n+1)
1361 {-# INLINE findIndex #-}
1362
1363 -- | The 'findIndices' function extends 'findIndex', by returning the
1364 -- indices of all elements satisfying the predicate, in ascending order.
1365 findIndices :: (Word8 -> Bool) -> ByteString -> [Int]
1366 findIndices p ps = loop 0 ps
1367    where
1368      STRICT2(loop)
1369      loop n qs | null qs           = []
1370                | p (unsafeHead qs) = n : loop (n+1) (unsafeTail qs)
1371                | otherwise         =     loop (n+1) (unsafeTail qs)
1372
1373 -- ---------------------------------------------------------------------
1374 -- Searching ByteStrings
1375
1376 -- | /O(n)/ 'elem' is the 'ByteString' membership predicate.
1377 elem :: Word8 -> ByteString -> Bool
1378 elem c ps = case elemIndex c ps of Nothing -> False ; _ -> True
1379 {-# INLINE elem #-}
1380
1381 -- | /O(n)/ 'notElem' is the inverse of 'elem'
1382 notElem :: Word8 -> ByteString -> Bool
1383 notElem c ps = not (elem c ps)
1384 {-# INLINE notElem #-}
1385
1386 -- | /O(n)/ 'filter', applied to a predicate and a ByteString,
1387 -- returns a ByteString containing those characters that satisfy the
1388 -- predicate. This function is subject to array fusion.
1389 filter :: (Word8 -> Bool) -> ByteString -> ByteString
1390 #if defined(LOOPU_FUSION)
1391 filter p  = loopArr . loopU (filterEFL p) NoAcc
1392 #elif defined(LOOPUP_FUSION)
1393 filter p  = loopArr . loopUp (filterEFL p) NoAcc
1394 #elif defined(LOOPNOACC_FUSION)
1395 filter p  = loopArr . loopNoAcc (filterEFL p)
1396 #else
1397 filter f = loopArr . loopFilter f
1398 #endif
1399 {-# INLINE filter #-}
1400
1401 {-
1402 -- | /O(n)/ 'filter\'' is a non-fuseable version of filter, that may be
1403 -- around 2x faster for some one-shot applications.
1404 filter' :: (Word8 -> Bool) -> ByteString -> ByteString
1405 filter' k ps@(PS x s l)
1406     | null ps   = ps
1407     | otherwise = unsafePerformIO $ createAndTrim l $ \p -> withForeignPtr x $ \f -> do
1408         t <- go (f `plusPtr` s) p (f `plusPtr` (s + l))
1409         return $! t `minusPtr` p -- actual length
1410     where
1411         STRICT3(go)
1412         go f t end | f == end  = return t
1413                    | otherwise = do
1414                         w <- peek f
1415                         if k w
1416                             then poke t w >> go (f `plusPtr` 1) (t `plusPtr` 1) end
1417                             else             go (f `plusPtr` 1) t               end
1418 {-# INLINE filter' #-}
1419 -}
1420
1421 --
1422 -- | /O(n)/ A first order equivalent of /filter . (==)/, for the common
1423 -- case of filtering a single byte. It is more efficient to use
1424 -- /filterByte/ in this case.
1425 --
1426 -- > filterByte == filter . (==)
1427 --
1428 -- filterByte is around 10x faster, and uses much less space, than its
1429 -- filter equivalent
1430 filterByte :: Word8 -> ByteString -> ByteString
1431 filterByte w ps = replicate (count w ps) w
1432 {-# INLINE filterByte #-}
1433
1434 {-# RULES
1435   "FPS specialise filter (== x)" forall x.
1436       filter ((==) x) = filterByte x
1437   #-}
1438 --
1439 -- | /O(n)/ A first order equivalent of /filter . (\/=)/, for the common
1440 -- case of filtering a single byte out of a list. It is more efficient
1441 -- to use /filterNotByte/ in this case.
1442 --
1443 -- > filterNotByte == filter . (/=)
1444 --
1445 -- filterNotByte is around 2x faster than its filter equivalent.
1446 filterNotByte :: Word8 -> ByteString -> ByteString
1447 filterNotByte w = filter (/= w)
1448 {-# INLINE filterNotByte #-}
1449
1450 {-# RULES
1451 "FPS specialise filter (/= x)" forall x.
1452     filter ((/=) x) = filterNotByte x
1453   #-}
1454 -- | /O(n)/ The 'find' function takes a predicate and a ByteString,
1455 -- and returns the first element in matching the predicate, or 'Nothing'
1456 -- if there is no such element.
1457 --
1458 -- > find f p = case findIndex f p of Just n -> Just (p ! n) ; _ -> Nothing
1459 --
1460 find :: (Word8 -> Bool) -> ByteString -> Maybe Word8
1461 find f p = case findIndex f p of
1462                     Just n -> Just (p `unsafeIndex` n)
1463                     _      -> Nothing
1464 {-# INLINE find #-}
1465
1466 {-
1467 --
1468 -- fuseable, but we don't want to walk the whole array.
1469 --
1470 find k = foldl findEFL Nothing
1471     where findEFL a@(Just _) _ = a
1472           findEFL _          c | k c       = Just c
1473                                | otherwise = Nothing
1474 -}
1475
1476 -- ---------------------------------------------------------------------
1477 -- Searching for substrings
1478
1479 -- | /O(n)/ The 'isPrefixOf' function takes two ByteStrings and returns 'True'
1480 -- iff the first is a prefix of the second.
1481 isPrefixOf :: ByteString -> ByteString -> Bool
1482 isPrefixOf (PS x1 s1 l1) (PS x2 s2 l2)
1483     | l1 == 0   = True
1484     | l2 < l1   = False
1485     | otherwise = inlinePerformIO $ withForeignPtr x1 $ \p1 ->
1486         withForeignPtr x2 $ \p2 -> do
1487             i <- memcmp (p1 `plusPtr` s1) (p2 `plusPtr` s2) (fromIntegral l1)
1488             return $! i == 0
1489
1490 -- | /O(n)/ The 'isSuffixOf' function takes two ByteStrings and returns 'True'
1491 -- iff the first is a suffix of the second.
1492 --
1493 -- The following holds:
1494 --
1495 -- > isSuffixOf x y == reverse x `isPrefixOf` reverse y
1496 --
1497 -- However, the real implemenation uses memcmp to compare the end of the
1498 -- string only, with no reverse required..
1499 isSuffixOf :: ByteString -> ByteString -> Bool
1500 isSuffixOf (PS x1 s1 l1) (PS x2 s2 l2)
1501     | l1 == 0   = True
1502     | l2 < l1   = False
1503     | otherwise = inlinePerformIO $ withForeignPtr x1 $ \p1 ->
1504         withForeignPtr x2 $ \p2 -> do
1505             i <- memcmp (p1 `plusPtr` s1) (p2 `plusPtr` s2 `plusPtr` (l2 - l1)) (fromIntegral l1)
1506             return $! i == 0
1507
1508 -- | Check whether one string is a substring of another. @isSubstringOf
1509 -- p s@ is equivalent to @not (null (findSubstrings p s))@.
1510 isSubstringOf :: ByteString -- ^ String to search for.
1511               -> ByteString -- ^ String to search in.
1512               -> Bool
1513 isSubstringOf p s = not $ P.null $ findSubstrings p s
1514
1515 -- | Get the first index of a substring in another string,
1516 --   or 'Nothing' if the string is not found.
1517 --   @findSubstring p s@ is equivalent to @listToMaybe (findSubstrings p s)@.
1518 findSubstring :: ByteString -- ^ String to search for.
1519               -> ByteString -- ^ String to seach in.
1520               -> Maybe Int
1521 findSubstring = (listToMaybe .) . findSubstrings
1522
1523 -- | Find the indexes of all (possibly overlapping) occurances of a
1524 -- substring in a string.  This function uses the Knuth-Morris-Pratt
1525 -- string matching algorithm.
1526 findSubstrings :: ByteString -- ^ String to search for.
1527                -> ByteString -- ^ String to seach in.
1528                -> [Int]
1529
1530 findSubstrings pat@(PS _ _ m) str@(PS _ _ n) = search 0 0
1531   where
1532       patc x = pat `unsafeIndex` x
1533       strc x = str `unsafeIndex` x
1534
1535       -- maybe we should make kmpNext a UArray before using it in search?
1536       kmpNext = listArray (0,m) (-1:kmpNextL pat (-1))
1537       kmpNextL p _ | null p = []
1538       kmpNextL p j = let j' = next (unsafeHead p) j + 1
1539                          ps = unsafeTail p
1540                          x = if not (null ps) && unsafeHead ps == patc j'
1541                                 then kmpNext Array.! j' else j'
1542                         in x:kmpNextL ps j'
1543       search i j = match ++ rest -- i: position in string, j: position in pattern
1544         where match = if j == m then [(i - j)] else []
1545               rest = if i == n then [] else search (i+1) (next (strc i) j + 1)
1546       next c j | j >= 0 && (j == m || c /= patc j) = next c (kmpNext Array.! j)
1547                | otherwise = j
1548
1549 -- ---------------------------------------------------------------------
1550 -- Zipping
1551
1552 -- | /O(n)/ 'zip' takes two ByteStrings and returns a list of
1553 -- corresponding pairs of bytes. If one input ByteString is short,
1554 -- excess elements of the longer ByteString are discarded. This is
1555 -- equivalent to a pair of 'unpack' operations.
1556 zip :: ByteString -> ByteString -> [(Word8,Word8)]
1557 zip ps qs
1558     | null ps || null qs = []
1559     | otherwise = (unsafeHead ps, unsafeHead qs) : zip (unsafeTail ps) (unsafeTail qs)
1560
1561 -- | 'zipWith' generalises 'zip' by zipping with the function given as
1562 -- the first argument, instead of a tupling function.  For example,
1563 -- @'zipWith' (+)@ is applied to two ByteStrings to produce the list of
1564 -- corresponding sums.
1565 zipWith :: (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
1566 zipWith f ps qs
1567     | null ps || null qs = []
1568     | otherwise = f (unsafeHead ps) (unsafeHead qs) : zipWith f (unsafeTail ps) (unsafeTail qs)
1569
1570 --
1571 -- | A specialised version of zipWith for the common case of a
1572 -- simultaneous map over two bytestrings, to build a 3rd. Rewrite rules
1573 -- are used to automatically covert zipWith into zipWith' when a pack is
1574 -- performed on the result of zipWith, but we also export it for
1575 -- convenience.
1576 --
1577 zipWith' :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> ByteString
1578 zipWith' f (PS fp s l) (PS fq t m) = inlinePerformIO $
1579     withForeignPtr fp $ \a ->
1580     withForeignPtr fq $ \b ->
1581     create len $ zipWith_ 0 (a `plusPtr` s) (b `plusPtr` t)
1582   where
1583     zipWith_ :: Int -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()
1584     STRICT4(zipWith_)
1585     zipWith_ n p1 p2 r
1586        | n >= len = return ()
1587        | otherwise = do
1588             x <- peekByteOff p1 n
1589             y <- peekByteOff p2 n
1590             pokeByteOff r n (f x y)
1591             zipWith_ (n+1) p1 p2 r
1592
1593     len = min l m
1594 {-# INLINE zipWith' #-}
1595
1596 {-# RULES
1597
1598 "FPS specialise zipWith" forall (f :: Word8 -> Word8 -> Word8) p q .
1599     zipWith f p q = unpack (zipWith' f p q)
1600   #-}
1601
1602 -- | /O(n)/ 'unzip' transforms a list of pairs of bytes into a pair of
1603 -- ByteStrings. Note that this performs two 'pack' operations.
1604 unzip :: [(Word8,Word8)] -> (ByteString,ByteString)
1605 unzip ls = (pack (P.map fst ls), pack (P.map snd ls))
1606 {-# INLINE unzip #-}
1607
1608 -- ---------------------------------------------------------------------
1609 -- Special lists
1610
1611 -- | /O(n)/ Return all initial segments of the given 'ByteString', shortest first.
1612 inits :: ByteString -> [ByteString]
1613 inits (PS x s l) = [PS x s n | n <- [0..l]]
1614
1615 -- | /O(n)/ Return all final segments of the given 'ByteString', longest first.
1616 tails :: ByteString -> [ByteString]
1617 tails p | null p    = [empty]
1618         | otherwise = p : tails (unsafeTail p)
1619
1620 -- less efficent spacewise: tails (PS x s l) = [PS x (s+n) (l-n) | n <- [0..l]]
1621
1622 -- ---------------------------------------------------------------------
1623 -- ** Ordered 'ByteString's
1624
1625 -- | /O(n)/ Sort a ByteString efficiently, using counting sort.
1626 sort :: ByteString -> ByteString
1627 sort (PS input s l) = unsafeCreate l $ \p -> allocaArray 256 $ \arr -> do
1628
1629     memset (castPtr arr) 0 (256 * fromIntegral (sizeOf (undefined :: CSize)))
1630     withForeignPtr input (\x -> countOccurrences arr (x `plusPtr` s) l)
1631
1632     let STRICT2(go)
1633         go 256 _   = return ()
1634         go i   ptr = do n <- peekElemOff arr i
1635                         when (n /= 0) $ memset ptr (fromIntegral i) n >> return ()
1636                         go (i + 1) (ptr `plusPtr` (fromIntegral n))
1637     go 0 p
1638
1639 {-
1640 sort :: ByteString -> ByteString
1641 sort (PS x s l) = unsafeCreate l $ \p -> withForeignPtr x $ \f -> do
1642         memcpy p (f `plusPtr` s) l
1643         c_qsort p l -- inplace
1644 -}
1645
1646 -- | The 'sortBy' function is the non-overloaded version of 'sort'.
1647 --
1648 -- Try some linear sorts: radix, counting
1649 -- Or mergesort.
1650 --
1651 -- sortBy :: (Word8 -> Word8 -> Ordering) -> ByteString -> ByteString
1652 -- sortBy f ps = undefined
1653
1654 -- ---------------------------------------------------------------------
1655 -- Low level constructors
1656
1657 -- | /O(n)/ Build a @ByteString@ from a @CString@. This value will have /no/
1658 -- finalizer associated to it. The ByteString length is calculated using
1659 -- /strlen(3)/, and thus the complexity is a /O(n)/.
1660 packCString :: CString -> ByteString
1661 packCString cstr = unsafePerformIO $ do
1662     fp <- newForeignPtr_ (castPtr cstr)
1663     l <- c_strlen cstr
1664     return $! PS fp 0 (fromIntegral l)
1665
1666 -- | /O(1)/ Build a @ByteString@ from a @CStringLen@. This value will
1667 -- have /no/ finalizer associated with it. This operation has /O(1)/
1668 -- complexity as we already know the final size, so no /strlen(3)/ is
1669 -- required.
1670 packCStringLen :: CStringLen -> ByteString
1671 packCStringLen (ptr,len) = unsafePerformIO $ do
1672     fp <- newForeignPtr_ (castPtr ptr)
1673     return $! PS fp 0 (fromIntegral len)
1674
1675 -- | /O(n)/ Build a @ByteString@ from a malloced @CString@. This value will
1676 -- have a @free(3)@ finalizer associated to it.
1677 packMallocCString :: CString -> ByteString
1678 packMallocCString cstr = unsafePerformIO $ do
1679     fp <- newForeignFreePtr (castPtr cstr)
1680     len <- c_strlen cstr
1681     return $! PS fp 0 (fromIntegral len)
1682
1683 -- | /O(n) construction/ Use a @ByteString@ with a function requiring a
1684 -- null-terminated @CString@.  The @CString@ will be freed
1685 -- automatically. This is a memcpy(3).
1686 useAsCString :: ByteString -> (CString -> IO a) -> IO a
1687 useAsCString (PS ps s l) = bracket alloc (c_free.castPtr)
1688     where alloc = withForeignPtr ps $ \p -> do
1689             buf <- c_malloc (fromIntegral l+1)
1690             memcpy (castPtr buf) (castPtr p `plusPtr` s) (fromIntegral l)
1691             poke (buf `plusPtr` l) (0::Word8) -- n.b.
1692             return (castPtr buf)
1693
1694 -- | /O(1) construction/ Use a @ByteString@ with a function requiring a @CStringLen@.
1695 useAsCStringLen :: ByteString -> (CStringLen -> IO a) -> IO a
1696 useAsCStringLen = unsafeUseAsCStringLen
1697
1698 --
1699 -- why were we doing this?
1700 --
1701 -- useAsCStringLen :: ByteString -> (CStringLen -> IO a) -> IO a
1702 -- useAsCStringLen (PS ps s l) = bracket alloc (c_free.castPtr.fst)
1703 --     where
1704 --       alloc = withForeignPtr ps $ \p -> do
1705 --                 buf <- c_malloc (fromIntegral l+1)
1706 --                 memcpy (castPtr buf) (castPtr p `plusPtr` s) (fromIntegral l)
1707 --                 poke (buf `plusPtr` l) (0::Word8) -- n.b.
1708 --                 return $! (castPtr buf, l)
1709 --
1710
1711 -- | /O(n)/ Make a copy of the 'ByteString' with its own storage.
1712 --   This is mainly useful to allow the rest of the data pointed
1713 --   to by the 'ByteString' to be garbage collected, for example
1714 --   if a large string has been read in, and only a small part of it
1715 --   is needed in the rest of the program.
1716 copy :: ByteString -> ByteString
1717 copy (PS x s l) = unsafeCreate l $ \p -> withForeignPtr x $ \f ->
1718     memcpy p (f `plusPtr` s) (fromIntegral l)
1719
1720 -- | /O(n)/ Duplicate a CString as a ByteString. Useful if you know the
1721 -- CString is going to be deallocated from C land.
1722 copyCString :: CString -> IO ByteString
1723 copyCString cstr = do
1724     len <- c_strlen cstr
1725     copyCStringLen (cstr, fromIntegral len)
1726
1727 -- | /O(n)/ Same as copyCString, but saves a strlen call when the length is known.
1728 copyCStringLen :: CStringLen -> IO ByteString
1729 copyCStringLen (cstr, len) = create len $ \p ->
1730     memcpy p (castPtr cstr) (fromIntegral len)
1731
1732 -- ---------------------------------------------------------------------
1733 -- line IO
1734
1735 -- | Read a line from stdin.
1736 getLine :: IO ByteString
1737 getLine = hGetLine stdin
1738
1739 {-
1740 -- | Lazily construct a list of lines of ByteStrings. This will be much
1741 -- better on memory consumption than using 'hGetContents >>= lines'
1742 -- If you're considering this, a better choice might be to use
1743 -- Data.ByteString.Lazy
1744 hGetLines :: Handle -> IO [ByteString]
1745 hGetLines h = go
1746     where
1747         go = unsafeInterleaveIO $ do
1748                 e <- hIsEOF h
1749                 if e
1750                   then return []
1751                   else do
1752                 x  <- hGetLine h
1753                 xs <- go
1754                 return (x:xs)
1755 -}
1756
1757 -- | Read a line from a handle
1758
1759 hGetLine :: Handle -> IO ByteString
1760 #if !defined(__GLASGOW_HASKELL__)
1761 hGetLine h = do
1762   string <- System.IO.hGetLine h
1763   return $ packWith c2w string
1764 #else
1765 hGetLine h = wantReadableHandle "Data.ByteString.hGetLine" h $ \ handle_ -> do
1766     case haBufferMode handle_ of
1767        NoBuffering -> error "no buffering"
1768        _other      -> hGetLineBuffered handle_
1769
1770  where
1771     hGetLineBuffered handle_ = do
1772         let ref = haBuffer handle_
1773         buf <- readIORef ref
1774         hGetLineBufferedLoop handle_ ref buf 0 []
1775
1776     hGetLineBufferedLoop handle_ ref
1777             buf@Buffer{ bufRPtr=r, bufWPtr=w, bufBuf=raw } len xss =
1778         len `seq` do
1779         off <- findEOL r w raw
1780         let new_len = len + off - r
1781         xs <- mkPS raw r off
1782
1783       -- if eol == True, then off is the offset of the '\n'
1784       -- otherwise off == w and the buffer is now empty.
1785         if off /= w
1786             then do if (w == off + 1)
1787                             then writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
1788                             else writeIORef ref buf{ bufRPtr = off + 1 }
1789                     mkBigPS new_len (xs:xss)
1790             else do
1791                  maybe_buf <- maybeFillReadBuffer (haFD handle_) True (haIsStream handle_)
1792                                     buf{ bufWPtr=0, bufRPtr=0 }
1793                  case maybe_buf of
1794                     -- Nothing indicates we caught an EOF, and we may have a
1795                     -- partial line to return.
1796                     Nothing -> do
1797                          writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
1798                          if new_len > 0
1799                             then mkBigPS new_len (xs:xss)
1800                             else ioe_EOF
1801                     Just new_buf ->
1802                          hGetLineBufferedLoop handle_ ref new_buf new_len (xs:xss)
1803
1804     -- find the end-of-line character, if there is one
1805     findEOL r w raw
1806         | r == w = return w
1807         | otherwise =  do
1808             (c,r') <- readCharFromBuffer raw r
1809             if c == '\n'
1810                 then return r -- NB. not r': don't include the '\n'
1811                 else findEOL r' w raw
1812
1813     maybeFillReadBuffer fd is_line is_stream buf = catch
1814         (do buf' <- fillReadBuffer fd is_line is_stream buf
1815             return (Just buf'))
1816         (\e -> if isEOFError e then return Nothing else ioError e)
1817
1818 -- TODO, rewrite to use normal memcpy
1819 mkPS :: RawBuffer -> Int -> Int -> IO ByteString
1820 mkPS buf start end =
1821     let len = end - start
1822     in create len $ \p -> do
1823         memcpy_ptr_baoff p buf (fromIntegral start) (fromIntegral len)
1824         return ()
1825
1826 mkBigPS :: Int -> [ByteString] -> IO ByteString
1827 mkBigPS _ [ps] = return ps
1828 mkBigPS _ pss = return $! concat (P.reverse pss)
1829
1830 #endif
1831
1832 -- ---------------------------------------------------------------------
1833 -- Block IO
1834
1835 -- | Outputs a 'ByteString' to the specified 'Handle'.
1836 hPut :: Handle -> ByteString -> IO ()
1837 hPut _ (PS _  _ 0) = return ()
1838 hPut h (PS ps s l) = withForeignPtr ps $ \p-> hPutBuf h (p `plusPtr` s) l
1839
1840 -- | A synonym for @hPut@, for compatibility
1841 hPutStr :: Handle -> ByteString -> IO ()
1842 hPutStr = hPut
1843
1844 -- | Write a ByteString to a handle, appending a newline byte
1845 hPutStrLn :: Handle -> ByteString -> IO ()
1846 hPutStrLn h ps
1847     | length ps < 1024 = hPut h (ps `snoc` 0x0a)
1848     | otherwise        = hPut h ps >> hPut h (singleton (0x0a)) -- don't copy
1849
1850 -- | Write a ByteString to stdout
1851 putStr :: ByteString -> IO ()
1852 putStr = hPut stdout
1853
1854 -- | Write a ByteString to stdout, appending a newline byte
1855 putStrLn :: ByteString -> IO ()
1856 putStrLn = hPutStrLn stdout
1857
1858 -- | Read a 'ByteString' directly from the specified 'Handle'.  This
1859 -- is far more efficient than reading the characters into a 'String'
1860 -- and then using 'pack'.
1861 hGet :: Handle -> Int -> IO ByteString
1862 hGet _ 0 = return empty
1863 hGet h i = createAndTrim i $ \p -> hGetBuf h p i
1864
1865 -- | hGetNonBlocking is identical to 'hGet', except that it will never block
1866 -- waiting for data to become available, instead it returns only whatever data
1867 -- is available.
1868 hGetNonBlocking :: Handle -> Int -> IO ByteString
1869 #if defined(__GLASGOW_HASKELL__)
1870 hGetNonBlocking _ 0 = return empty
1871 hGetNonBlocking h i = createAndTrim i $ \p -> hGetBufNonBlocking h p i
1872 #else
1873 hGetNonBlocking = hGet
1874 #endif
1875
1876 -- | Read entire handle contents into a 'ByteString'.
1877 -- This function reads chunks at a time, doubling the chunksize on each
1878 -- read. The final buffer is then realloced to the appropriate size. For
1879 -- files > half of available memory, this may lead to memory exhaustion.
1880 -- Consider using 'readFile' in this case.
1881 --
1882 -- As with 'hGet', the string representation in the file is assumed to
1883 -- be ISO-8859-1.
1884 --
1885 hGetContents :: Handle -> IO ByteString
1886 hGetContents h = do
1887     let start_size = 1024
1888     p <- mallocArray start_size
1889     i <- hGetBuf h p start_size
1890     if i < start_size
1891         then do p' <- reallocArray p i
1892                 fp <- newForeignFreePtr p'
1893                 return $! PS fp 0 i
1894         else f p start_size
1895     where
1896         f p s = do
1897             let s' = 2 * s
1898             p' <- reallocArray p s'
1899             i  <- hGetBuf h (p' `plusPtr` s) s
1900             if i < s
1901                 then do let i' = s + i
1902                         p'' <- reallocArray p' i'
1903                         fp  <- newForeignFreePtr p''
1904                         return $! PS fp 0 i'
1905                 else f p' s'
1906
1907 -- | getContents. Equivalent to hGetContents stdin
1908 getContents :: IO ByteString
1909 getContents = hGetContents stdin
1910
1911 -- | The interact function takes a function of type @ByteString -> ByteString@
1912 -- as its argument. The entire input from the standard input device is passed
1913 -- to this function as its argument, and the resulting string is output on the
1914 -- standard output device. It's great for writing one line programs!
1915 interact :: (ByteString -> ByteString) -> IO ()
1916 interact transformer = putStr . transformer =<< getContents
1917
1918 -- | Read an entire file strictly into a 'ByteString'.  This is far more
1919 -- efficient than reading the characters into a 'String' and then using
1920 -- 'pack'.  It also may be more efficient than opening the file and
1921 -- reading it using hGet. Files are read using 'binary mode' on Windows,
1922 -- for 'text mode' use the Char8 version of this function.
1923 readFile :: FilePath -> IO ByteString
1924 readFile f = bracket (openBinaryFile f ReadMode) hClose
1925     (\h -> hFileSize h >>= hGet h . fromIntegral)
1926
1927 -- | Write a 'ByteString' to a file.
1928 writeFile :: FilePath -> ByteString -> IO ()
1929 writeFile f txt = bracket (openBinaryFile f WriteMode) hClose
1930     (\h -> hPut h txt)
1931
1932 -- | Append a 'ByteString' to a file.
1933 appendFile :: FilePath -> ByteString -> IO ()
1934 appendFile f txt = bracket (openBinaryFile f AppendMode) hClose
1935     (\h -> hPut h txt)
1936
1937 {-
1938 --
1939 -- Disable until we can move it into a portable .hsc file
1940 --
1941
1942 -- | Like readFile, this reads an entire file directly into a
1943 -- 'ByteString', but it is even more efficient.  It involves directly
1944 -- mapping the file to memory.  This has the advantage that the contents
1945 -- of the file never need to be copied.  Also, under memory pressure the
1946 -- page may simply be discarded, while in the case of readFile it would
1947 -- need to be written to swap.  If you read many small files, mmapFile
1948 -- will be less memory-efficient than readFile, since each mmapFile
1949 -- takes up a separate page of memory.  Also, you can run into bus
1950 -- errors if the file is modified.  As with 'readFile', the string
1951 -- representation in the file is assumed to be ISO-8859-1.
1952 --
1953 -- On systems without mmap, this is the same as a readFile.
1954 --
1955 mmapFile :: FilePath -> IO ByteString
1956 mmapFile f = mmap f >>= \(fp,l) -> return $! PS fp 0 l
1957
1958 mmap :: FilePath -> IO (ForeignPtr Word8, Int)
1959 mmap f = do
1960     h <- openBinaryFile f ReadMode
1961     l <- fromIntegral `fmap` hFileSize h
1962     -- Don't bother mmaping small files because each mmapped file takes up
1963     -- at least one full VM block.
1964     if l < mmap_limit
1965        then do thefp <- mallocByteString l
1966                withForeignPtr thefp $ \p-> hGetBuf h p l
1967                hClose h
1968                return (thefp, l)
1969        else do
1970                -- unix only :(
1971                fd <- fromIntegral `fmap` handleToFd h
1972                p  <- my_mmap l fd
1973                fp <- if p == nullPtr
1974                      then do thefp <- mallocByteString l
1975                              withForeignPtr thefp $ \p' -> hGetBuf h p' l
1976                              return thefp
1977                      else do
1978                           -- The munmap leads to crashes on OpenBSD.
1979                           -- maybe there's a use after unmap in there somewhere?
1980                           -- Bulat suggests adding the hClose to the
1981                           -- finalizer, excellent idea.
1982 #if !defined(__OpenBSD__)
1983                              let unmap = c_munmap p l >> return ()
1984 #else
1985                              let unmap = return ()
1986 #endif
1987                              fp <- newForeignPtr p unmap
1988                              return fp
1989                c_close fd
1990                hClose h
1991                return (fp, l)
1992     where mmap_limit = 16*1024
1993 -}
1994
1995 -- ---------------------------------------------------------------------
1996 -- Internal utilities
1997
1998 -- | 'findIndexOrEnd' is a variant of findIndex, that returns the length
1999 -- of the string if no element is found, rather than Nothing.
2000 findIndexOrEnd :: (Word8 -> Bool) -> ByteString -> Int
2001 findIndexOrEnd k (PS x s l) = inlinePerformIO $ withForeignPtr x $ \f -> go (f `plusPtr` s) 0
2002   where
2003     STRICT2(go)
2004     go ptr n | n >= l    = return l
2005              | otherwise = do w <- peek ptr
2006                               if k w
2007                                 then return n
2008                                 else go (ptr `plusPtr` 1) (n+1)
2009 {-# INLINE findIndexOrEnd #-}
2010
2011 -- | Perform an operation with a temporary ByteString
2012 withPtr :: ForeignPtr a -> (Ptr a -> IO b) -> b
2013 withPtr fp io = inlinePerformIO (withForeignPtr fp io)
2014 {-# INLINE withPtr #-}
2015
2016 -- Common up near identical calls to `error' to reduce the number
2017 -- constant strings created when compiled:
2018 errorEmptyList :: String -> a
2019 errorEmptyList fun = moduleError fun "empty ByteString"
2020 {-# NOINLINE errorEmptyList #-}
2021
2022 moduleError :: String -> String -> a
2023 moduleError fun msg = error ("Data.ByteString." ++ fun ++ ':':' ':msg)
2024 {-# NOINLINE moduleError #-}
2025
2026 -- Find from the end of the string using predicate
2027 findFromEndUntil :: (Word8 -> Bool) -> ByteString -> Int
2028 STRICT2(findFromEndUntil)
2029 findFromEndUntil f ps@(PS x s l) =
2030     if null ps then 0
2031     else if f (last ps) then l
2032          else findFromEndUntil f (PS x s (l-1))
2033
2034 {-# INLINE newForeignFreePtr #-}
2035 newForeignFreePtr :: Ptr Word8 -> IO (ForeignPtr Word8)
2036 newForeignFreePtr p = newForeignPtr c_free_finalizer p