{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE FlexibleContexts #-}
#ifdef TRUSTWORTHY
{-# LANGUAGE Trustworthy #-}
#endif

#include "lens-common.h"

-----------------------------------------------------------------------------

-- |

-- Module      :  Data.ByteString.Strict.Lens

-- Copyright   :  (C) 2012-2016 Edward Kmett

-- License     :  BSD-style (see the file LICENSE)

-- Maintainer  :  Edward Kmett <ekmett@gmail.com>

-- Stability   :  experimental

-- Portability :  non-portable

--

-- This module spends a lot of time fiddling around with 'Data.ByteString' internals

-- to work around <http://hackage.haskell.org/trac/ghc/ticket/7556> on older

-- Haskell Platforms and to improve constant and asymptotic factors in our performance.

----------------------------------------------------------------------------

module Control.Lens.Internal.ByteString
  ( traversedStrictTree, traversedStrictTree8
  , traversedLazy, traversedLazy8
  ) where

import Prelude ()

import Control.Lens.Type
import Control.Lens.Getter
import Control.Lens.Fold
import Control.Lens.Internal.Fold (Rightmost(..))
import Control.Lens.Indexed
import Control.Lens.Internal.Prelude
import Control.Lens.Setter
import qualified Data.ByteString               as B
import qualified Data.ByteString.Char8         as B8
import qualified Data.ByteString.Lazy          as BL
import qualified Data.ByteString.Lazy.Char8    as BL8
import qualified Data.ByteString.Internal      as BI
import qualified Data.ByteString.Unsafe        as BU
import Data.Bits
import Data.Char
import Data.Int (Int64)
import Data.Word (Word8)
import Foreign.Ptr
import Foreign.Storable
import Foreign.ForeignPtr
import GHC.Base (unsafeChr)
import GHC.ForeignPtr (mallocPlainForeignPtrBytes)
import GHC.IO (unsafeDupablePerformIO)

grain :: Int
grain :: Int
grain = Int
32
{-# INLINE grain #-}

-- | Traverse a strict 'B.ByteString' in a relatively balanced fashion, as a balanced tree with biased runs of

-- elements at the leaves.

traversedStrictTree :: IndexedTraversal' Int B.ByteString Word8
traversedStrictTree :: IndexedTraversal' Int ByteString Word8
traversedStrictTree p Word8 (f Word8)
pafb ByteString
bs = Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
len ((Ptr Word8 -> IO ()) -> ByteString)
-> f (Ptr Word8 -> IO ()) -> f ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> f (Ptr Word8 -> IO ())
forall {b}. Int -> Int -> f (Ptr b -> IO ())
go Int
0 Int
len
 where
   len :: Int
len = ByteString -> Int
B.length ByteString
bs
   go :: Int -> Int -> f (Ptr b -> IO ())
go !Int
i !Int
j
     | Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
grain Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
j, Int
k <- Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) Int
1 = (\Ptr b -> IO ()
l Ptr b -> IO ()
r Ptr b
q -> Ptr b -> IO ()
l Ptr b
q IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr b -> IO ()
r Ptr b
q) ((Ptr b -> IO ()) -> (Ptr b -> IO ()) -> Ptr b -> IO ())
-> f (Ptr b -> IO ()) -> f ((Ptr b -> IO ()) -> Ptr b -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> f (Ptr b -> IO ())
go Int
i Int
k f ((Ptr b -> IO ()) -> Ptr b -> IO ())
-> f (Ptr b -> IO ()) -> f (Ptr b -> IO ())
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> f (Ptr b -> IO ())
go Int
k Int
j
     | Bool
otherwise = Int -> Int -> f (Ptr b -> IO ())
forall {b}. Int -> Int -> f (Ptr b -> IO ())
run Int
i Int
j
   run :: Int -> Int -> f (Ptr b -> IO ())
run !Int
i !Int
j
     | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j    = (Ptr b -> IO ()) -> f (Ptr b -> IO ())
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\Ptr b
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
     | Bool
otherwise = let !x :: Word8
x = ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
i
                   in (\Word8
y Ptr b -> IO ()
ys Ptr b
q -> Ptr b -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
q Int
i Word8
y IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr b -> IO ()
ys Ptr b
q) (Word8 -> (Ptr b -> IO ()) -> Ptr b -> IO ())
-> f Word8 -> f ((Ptr b -> IO ()) -> Ptr b -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p Word8 (f Word8) -> Int -> Word8 -> f Word8
forall a b. p a b -> Int -> a -> b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p Word8 (f Word8)
pafb (Int
i :: Int) Word8
x f ((Ptr b -> IO ()) -> Ptr b -> IO ())
-> f (Ptr b -> IO ()) -> f (Ptr b -> IO ())
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> f (Ptr b -> IO ())
run (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
j
{-# INLINE [0] traversedStrictTree #-}

{-# RULES
"bytes -> map"    traversedStrictTree = sets B.map        :: ASetter' B.ByteString Word8;
"bytes -> imap"   traversedStrictTree = isets imapB       :: AnIndexedSetter' Int B.ByteString Word8;
"bytes -> foldr"  traversedStrictTree = foldring B.foldr  :: Getting (Endo r) B.ByteString Word8;
"bytes -> ifoldr" traversedStrictTree = ifoldring ifoldrB :: IndexedGetting Int (Endo r) B.ByteString Word8;
 #-}

imapB :: (Int -> Word8 -> Word8) -> B.ByteString -> B.ByteString
imapB :: (Int -> Word8 -> Word8) -> ByteString -> ByteString
imapB Int -> Word8 -> Word8
f = (Int, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((Int, ByteString) -> ByteString)
-> (ByteString -> (Int, ByteString)) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Word8 -> (Int, Word8))
-> Int -> ByteString -> (Int, ByteString)
forall acc.
(acc -> Word8 -> (acc, Word8))
-> acc -> ByteString -> (acc, ByteString)
B.mapAccumL (\Int
i Word8
a -> Int
i Int -> (Int, Word8) -> (Int, Word8)
forall a b. a -> b -> b
`seq` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int -> Word8 -> Word8
f Int
i Word8
a)) Int
0
{-# INLINE imapB #-}

ifoldrB :: (Int -> Word8 -> a -> a) -> a -> B.ByteString -> a
ifoldrB :: forall a. (Int -> Word8 -> a -> a) -> a -> ByteString -> a
ifoldrB Int -> Word8 -> a -> a
f a
z ByteString
xs = (Word8 -> (Int -> a) -> Int -> a)
-> (Int -> a) -> ByteString -> Int -> a
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
B.foldr (\ Word8
x Int -> a
g Int
i -> Int
i Int -> a -> a
forall a b. a -> b -> b
`seq` Int -> Word8 -> a -> a
f Int
i Word8
x (Int -> a
g (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))) (a -> Int -> a
forall a b. a -> b -> a
const a
z) ByteString
xs Int
0
{-# INLINE ifoldrB #-}

-- | Traverse a strict 'B.ByteString' in a relatively balanced fashion, as a balanced tree with biased runs of

-- elements at the leaves, pretending the bytes are chars.

traversedStrictTree8 :: IndexedTraversal' Int B.ByteString Char
traversedStrictTree8 :: IndexedTraversal' Int ByteString Char
traversedStrictTree8 p Char (f Char)
pafb ByteString
bs = Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
len ((Ptr Word8 -> IO ()) -> ByteString)
-> f (Ptr Word8 -> IO ()) -> f ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> f (Ptr Word8 -> IO ())
forall {b}. Int -> Int -> f (Ptr b -> IO ())
go Int
0 Int
len
 where
   len :: Int
len = ByteString -> Int
B.length ByteString
bs
   go :: Int -> Int -> f (Ptr b -> IO ())
go !Int
i !Int
j
     | Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
grain Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
j    = let k :: Int
k = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) Int
1
                          in (\Ptr b -> IO ()
l Ptr b -> IO ()
r Ptr b
q -> Ptr b -> IO ()
l Ptr b
q IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr b -> IO ()
r Ptr b
q) ((Ptr b -> IO ()) -> (Ptr b -> IO ()) -> Ptr b -> IO ())
-> f (Ptr b -> IO ()) -> f ((Ptr b -> IO ()) -> Ptr b -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> f (Ptr b -> IO ())
go Int
i Int
k f ((Ptr b -> IO ()) -> Ptr b -> IO ())
-> f (Ptr b -> IO ()) -> f (Ptr b -> IO ())
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> f (Ptr b -> IO ())
go Int
k Int
j
     | Bool
otherwise        = Int -> Int -> f (Ptr b -> IO ())
forall {b}. Int -> Int -> f (Ptr b -> IO ())
run Int
i Int
j
   run :: Int -> Int -> f (Ptr b -> IO ())
run !Int
i !Int
j
     | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j           = (Ptr b -> IO ()) -> f (Ptr b -> IO ())
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\Ptr b
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
     | Bool
otherwise        = let !x :: Word8
x = ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
i
                          in (\Char
y Ptr b -> IO ()
ys Ptr b
q -> Ptr b -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
q Int
i (Char -> Word8
c2w Char
y) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr b -> IO ()
ys Ptr b
q)
                         (Char -> (Ptr b -> IO ()) -> Ptr b -> IO ())
-> f Char -> f ((Ptr b -> IO ()) -> Ptr b -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p Char (f Char) -> Int -> Char -> f Char
forall a b. p a b -> Int -> a -> b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p Char (f Char)
pafb (Int
i :: Int) (Word8 -> Char
w2c Word8
x)
                         f ((Ptr b -> IO ()) -> Ptr b -> IO ())
-> f (Ptr b -> IO ()) -> f (Ptr b -> IO ())
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> f (Ptr b -> IO ())
run (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
j
{-# INLINE [0] traversedStrictTree8 #-}

{-# RULES
"chars -> map"    traversedStrictTree8 = sets B8.map        :: ASetter' B.ByteString Char;
"chars -> imap"   traversedStrictTree8 = isets imapB8       :: AnIndexedSetter' Int B.ByteString Char;
"chars -> foldr"  traversedStrictTree8 = foldring B8.foldr  :: Getting (Endo r) B.ByteString Char;
"chars -> ifoldr" traversedStrictTree8 = ifoldring ifoldrB8 :: IndexedGetting Int (Endo r) B.ByteString Char;
 #-}

imapB8 :: (Int -> Char -> Char) -> B.ByteString -> B.ByteString
imapB8 :: (Int -> Char -> Char) -> ByteString -> ByteString
imapB8 Int -> Char -> Char
f = (Int, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((Int, ByteString) -> ByteString)
-> (ByteString -> (Int, ByteString)) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Char -> (Int, Char))
-> Int -> ByteString -> (Int, ByteString)
forall acc.
(acc -> Char -> (acc, Char))
-> acc -> ByteString -> (acc, ByteString)
B8.mapAccumL (\Int
i Char
a -> Int
i Int -> (Int, Char) -> (Int, Char)
forall a b. a -> b -> b
`seq` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int -> Char -> Char
f Int
i Char
a)) Int
0
{-# INLINE imapB8 #-}

ifoldrB8 :: (Int -> Char -> a -> a) -> a -> B.ByteString -> a
ifoldrB8 :: forall a. (Int -> Char -> a -> a) -> a -> ByteString -> a
ifoldrB8 Int -> Char -> a -> a
f a
z ByteString
xs = (Char -> (Int -> a) -> Int -> a)
-> (Int -> a) -> ByteString -> Int -> a
forall a. (Char -> a -> a) -> a -> ByteString -> a
B8.foldr (\ Char
x Int -> a
g Int
i -> Int
i Int -> a -> a
forall a b. a -> b -> b
`seq` Int -> Char -> a -> a
f Int
i Char
x (Int -> a
g (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))) (a -> Int -> a
forall a b. a -> b -> a
const a
z) ByteString
xs Int
0
{-# INLINE ifoldrB8 #-}

-- | An 'IndexedTraversal' of the individual bytes in a lazy 'BL.ByteString'

traversedLazy :: IndexedTraversal' Int64 BL.ByteString Word8
traversedLazy :: IndexedTraversal' Int64 ByteString Word8
traversedLazy p Word8 (f Word8)
pafb = \ByteString
lbs -> (ByteString -> (Int64 -> f ByteString) -> Int64 -> f ByteString)
-> (Int64 -> f ByteString) -> ByteString -> Int64 -> f ByteString
forall a. (ByteString -> a -> a) -> a -> ByteString -> a
BL.foldrChunks ByteString -> (Int64 -> f ByteString) -> Int64 -> f ByteString
go (\Int64
_ -> ByteString -> f ByteString
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
BL.empty) ByteString
lbs Int64
0
  where
  go :: ByteString -> (Int64 -> f ByteString) -> Int64 -> f ByteString
go ByteString
c Int64 -> f ByteString
fcs Int64
acc = ByteString -> ByteString -> ByteString
BL.append (ByteString -> ByteString -> ByteString)
-> (ByteString -> ByteString)
-> ByteString
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict
             (ByteString -> ByteString -> ByteString)
-> f ByteString -> f (ByteString -> ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int64)
-> (Indexed Int Word8 (f Word8) -> ByteString -> f ByteString)
-> p Word8 (f Word8)
-> ByteString
-> f ByteString
forall j (p :: * -> * -> *) i a b r.
Indexable j p =>
(i -> j) -> (Indexed i a b -> r) -> p a b -> r
reindexed (\Int
x -> Int64
acc Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x :: Int64) Indexed Int Word8 (f Word8) -> ByteString -> f ByteString
IndexedTraversal' Int ByteString Word8
traversedStrictTree p Word8 (f Word8)
pafb ByteString
c
             f (ByteString -> ByteString) -> f ByteString -> f ByteString
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int64 -> f ByteString
fcs Int64
acc'
    where
    acc' :: Int64
    !acc' :: Int64
acc' = Int64
acc Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
c)
{-# INLINE [1] traversedLazy #-}

{-# RULES
  "sets lazy bytestring"
    traversedLazy = sets BL.map :: ASetter' BL.ByteString Word8;
  "isets lazy bytestring"
    traversedLazy = isets imapBL :: AnIndexedSetter' Int BL.ByteString Word8;
  "gets lazy bytestring"
    traversedLazy = foldring BL.foldr :: Getting (Endo r) BL.ByteString Word8;
  "igets lazy bytestring"
    traversedLazy = ifoldring ifoldrBL :: IndexedGetting Int (Endo r) BL.ByteString Word8;
  "lastOf lazy bytestring"
    traversedLazy = lazyBytesRightmost :: Getting (Rightmost a) BL.ByteString Word8;
 #-}

-- | 'lastOf' and other strict-to-end 'Rightmost' folds are not covered by the

-- @Endo@ rule above, so without this they fall through to the general

-- 'traversedLazy', whose @foldrChunks@/@<*>@ builds a lazy thunk chain over the

-- chunk spine and retains memory proportional to the chunk count.

--

-- 'Rightmost' is strict-to-end (unlike the short-circuiting 'Leftmost'/'Any'),

-- so a strict 'BL.foldl'' is sound: @acc <> 'RLeaf' w@ discards @acc@, so the

-- fold runs in constant space. We deliberately do /not/ do this for

-- 'firstOf'/'anyOf', whose laziness is load-bearing.

lazyBytesRightmost :: Getting (Rightmost a) BL.ByteString Word8
lazyBytesRightmost :: forall a. Getting (Rightmost a) ByteString Word8
lazyBytesRightmost Word8 -> Const (Rightmost a) Word8
f = Rightmost a -> Const (Rightmost a) ByteString
forall {k} a (b :: k). a -> Const a b
Const (Rightmost a -> Const (Rightmost a) ByteString)
-> (ByteString -> Rightmost a)
-> ByteString
-> Const (Rightmost a) ByteString
forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> (a -> b) -> a -> c
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. (Rightmost a -> Word8 -> Rightmost a)
-> Rightmost a -> ByteString -> Rightmost a
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BL.foldl' (\Rightmost a
acc Word8
w -> Rightmost a -> Rightmost a -> Rightmost a
forall a. Rightmost a -> Rightmost a -> Rightmost a
stepRightmost Rightmost a
acc (Const (Rightmost a) Word8 -> Rightmost a
forall {k} a (b :: k). Const a b -> a
getConst (Word8 -> Const (Rightmost a) Word8
f Word8
w))) Rightmost a
forall a. Monoid a => a
mempty
{-# INLINE lazyBytesRightmost #-}

-- | One step of a strict 'Rightmost' left fold. @(<>)@ for 'Rightmost' always

-- wraps its result in 'RStep' and is lazy in the left argument; for the

-- @'RLeaf' w@ values 'lastOf' feeds in, @acc <> 'RLeaf' w = 'RStep' ('RLeaf' w)@,

-- so forcing that 'RStep' payload to WHNF drops @acc@ and the fold runs in

-- constant space (a plain @foldl' (<>)@ would instead retain an O(n) chain of

-- thunks, each closing over the prior accumulator).

--

-- Note this rewrite is sound even though 'Rightmost'\'s @(<>)@ is /not/

-- value-level associative (left- vs right-nesting insert different numbers of

-- 'RStep' layers): the only consumer of @'Getting' ('Rightmost' a)@ is 'lastOf',

-- which observes solely 'getRightmost', and 'getRightmost' is invariant under

-- both re-association and extra 'RStep' layers. The 'seq' only forces, so the

-- strict left fold agrees with the lawful traversal on every observation

-- 'lastOf' can make.

stepRightmost :: Rightmost a -> Rightmost a -> Rightmost a
stepRightmost :: forall a. Rightmost a -> Rightmost a -> Rightmost a
stepRightmost Rightmost a
acc Rightmost a
r = case Rightmost a
acc Rightmost a -> Rightmost a -> Rightmost a
forall a. Semigroup a => a -> a -> a
<> Rightmost a
r of
                        s :: Rightmost a
s@(RStep Rightmost a
x) -> Rightmost a
x Rightmost a -> Rightmost a -> Rightmost a
forall a b. a -> b -> b
`seq` Rightmost a
s
                        Rightmost a
s           -> Rightmost a
s
{-# INLINE stepRightmost #-}

imapBL :: (Int -> Word8 -> Word8) -> BL.ByteString -> BL.ByteString
imapBL :: (Int -> Word8 -> Word8) -> ByteString -> ByteString
imapBL Int -> Word8 -> Word8
f = (Int, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((Int, ByteString) -> ByteString)
-> (ByteString -> (Int, ByteString)) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Word8 -> (Int, Word8))
-> Int -> ByteString -> (Int, ByteString)
forall acc.
(acc -> Word8 -> (acc, Word8))
-> acc -> ByteString -> (acc, ByteString)
BL.mapAccumL (\Int
i Word8
a -> Int
i Int -> (Int, Word8) -> (Int, Word8)
forall a b. a -> b -> b
`seq` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int -> Word8 -> Word8
f Int
i Word8
a)) Int
0
{-# INLINE imapBL #-}

ifoldrBL :: (Int -> Word8 -> a -> a) -> a -> BL.ByteString -> a
ifoldrBL :: forall a. (Int -> Word8 -> a -> a) -> a -> ByteString -> a
ifoldrBL Int -> Word8 -> a -> a
f a
z ByteString
xs = (Word8 -> (Int -> a) -> Int -> a)
-> (Int -> a) -> ByteString -> Int -> a
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
BL.foldr (\ Word8
x Int -> a
g Int
i -> Int
i Int -> a -> a
forall a b. a -> b -> b
`seq` Int -> Word8 -> a -> a
f Int
i Word8
x (Int -> a
g (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))) (a -> Int -> a
forall a b. a -> b -> a
const a
z) ByteString
xs Int
0
{-# INLINE ifoldrBL #-}

-- | An 'IndexedTraversal' of the individual bytes in a lazy 'BL.ByteString' pretending the bytes are chars.

traversedLazy8 :: IndexedTraversal' Int64 BL.ByteString Char
traversedLazy8 :: IndexedTraversal' Int64 ByteString Char
traversedLazy8 p Char (f Char)
pafb = \ByteString
lbs -> (ByteString -> (Int64 -> f ByteString) -> Int64 -> f ByteString)
-> (Int64 -> f ByteString) -> ByteString -> Int64 -> f ByteString
forall a. (ByteString -> a -> a) -> a -> ByteString -> a
BL.foldrChunks ByteString -> (Int64 -> f ByteString) -> Int64 -> f ByteString
go (\Int64
_ -> ByteString -> f ByteString
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
BL.empty) ByteString
lbs Int64
0
  where
  go :: ByteString -> (Int64 -> f ByteString) -> Int64 -> f ByteString
go ByteString
c Int64 -> f ByteString
fcs Int64
acc = ByteString -> ByteString -> ByteString
BL.append (ByteString -> ByteString -> ByteString)
-> (ByteString -> ByteString)
-> ByteString
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict
             (ByteString -> ByteString -> ByteString)
-> f ByteString -> f (ByteString -> ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Int64)
-> (Indexed Int Char (f Char) -> ByteString -> f ByteString)
-> p Char (f Char)
-> ByteString
-> f ByteString
forall j (p :: * -> * -> *) i a b r.
Indexable j p =>
(i -> j) -> (Indexed i a b -> r) -> p a b -> r
reindexed (\Int
x -> Int64
acc Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x :: Int64) Indexed Int Char (f Char) -> ByteString -> f ByteString
IndexedTraversal' Int ByteString Char
traversedStrictTree8 p Char (f Char)
pafb ByteString
c
             f (ByteString -> ByteString) -> f ByteString -> f ByteString
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int64 -> f ByteString
fcs Int64
acc'
    where
    acc' :: Int64
    !acc' :: Int64
acc' = Int64
acc Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
c)
{-# INLINE [1] traversedLazy8 #-}

{-# RULES
  "sets lazy bytestring"
    traversedLazy8 = sets BL8.map :: ASetter' BL8.ByteString Char;
  "isets lazy bytestring"
    traversedLazy8 = isets imapBL8 :: AnIndexedSetter' Int BL8.ByteString Char;
  "gets lazy bytestring"
    traversedLazy8 = foldring BL8.foldr :: Getting (Endo r) BL8.ByteString Char;
  "igets lazy bytestring"
    traversedLazy8 = ifoldring ifoldrBL8 :: IndexedGetting Int (Endo r) BL8.ByteString Char;
  "lastOf lazy bytestring"
    traversedLazy8 = lazyBytesRightmost8 :: Getting (Rightmost a) BL8.ByteString Char;
 #-}

-- | See 'lazyBytesRightmost'; this is the @Char@ analogue for 'traversedLazy8'.

lazyBytesRightmost8 :: Getting (Rightmost a) BL8.ByteString Char
lazyBytesRightmost8 :: forall a. Getting (Rightmost a) ByteString Char
lazyBytesRightmost8 Char -> Const (Rightmost a) Char
f = Rightmost a -> Const (Rightmost a) ByteString
forall {k} a (b :: k). a -> Const a b
Const (Rightmost a -> Const (Rightmost a) ByteString)
-> (ByteString -> Rightmost a)
-> ByteString
-> Const (Rightmost a) ByteString
forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> (a -> b) -> a -> c
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. (Rightmost a -> Char -> Rightmost a)
-> Rightmost a -> ByteString -> Rightmost a
forall a. (a -> Char -> a) -> a -> ByteString -> a
BL8.foldl' (\Rightmost a
acc Char
c -> Rightmost a -> Rightmost a -> Rightmost a
forall a. Rightmost a -> Rightmost a -> Rightmost a
stepRightmost Rightmost a
acc (Const (Rightmost a) Char -> Rightmost a
forall {k} a (b :: k). Const a b -> a
getConst (Char -> Const (Rightmost a) Char
f Char
c))) Rightmost a
forall a. Monoid a => a
mempty
{-# INLINE lazyBytesRightmost8 #-}

imapBL8 :: (Int -> Char -> Char) -> BL8.ByteString -> BL8.ByteString
imapBL8 :: (Int -> Char -> Char) -> ByteString -> ByteString
imapBL8 Int -> Char -> Char
f = (Int, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((Int, ByteString) -> ByteString)
-> (ByteString -> (Int, ByteString)) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Char -> (Int, Char))
-> Int -> ByteString -> (Int, ByteString)
forall acc.
(acc -> Char -> (acc, Char))
-> acc -> ByteString -> (acc, ByteString)
BL8.mapAccumL (\Int
i Char
a -> Int
i Int -> (Int, Char) -> (Int, Char)
forall a b. a -> b -> b
`seq` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int -> Char -> Char
f Int
i Char
a)) Int
0
{-# INLINE imapBL8 #-}

ifoldrBL8 :: (Int -> Char -> a -> a) -> a -> BL8.ByteString -> a
ifoldrBL8 :: forall a. (Int -> Char -> a -> a) -> a -> ByteString -> a
ifoldrBL8 Int -> Char -> a -> a
f a
z ByteString
xs = (Char -> (Int -> a) -> Int -> a)
-> (Int -> a) -> ByteString -> Int -> a
forall a. (Char -> a -> a) -> a -> ByteString -> a
BL8.foldr (\ Char
x Int -> a
g Int
i -> Int
i Int -> a -> a
forall a b. a -> b -> b
`seq` Int -> Char -> a -> a
f Int
i Char
x (Int -> a
g (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))) (a -> Int -> a
forall a b. a -> b -> a
const a
z) ByteString
xs Int
0
{-# INLINE ifoldrBL8 #-}

------------------------------------------------------------------------------

-- ByteString guts

------------------------------------------------------------------------------


-- | Conversion between 'Word8' and 'Char'. Should compile to a no-op.

w2c :: Word8 -> Char
w2c :: Word8 -> Char
w2c = Int -> Char
unsafeChr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE w2c #-}

-- | Unsafe conversion between 'Char' and 'Word8'. This is a no-op and

-- silently truncates to 8 bits Chars > '\255'. It is provided as

-- convenience for ByteString construction.

c2w :: Char -> Word8
c2w :: Char -> Word8
c2w = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
{-# INLINE c2w #-}

-- | A way of creating ByteStrings outside the IO monad. The @Int@

-- argument gives the final size of the ByteString. Unlike

-- 'createAndTrim' the ByteString is not reallocated if the final size

-- is less than the estimated size.

unsafeCreate :: Int -> (Ptr Word8 -> IO ()) -> B.ByteString
unsafeCreate :: Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
l Ptr Word8 -> IO ()
f = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
l Ptr Word8 -> IO ()
f)
{-# INLINE unsafeCreate #-}

-- | Create ByteString of size @l@ and use action @f@ to fill it's contents.

create :: Int -> (Ptr Word8 -> IO ()) -> IO B.ByteString
create :: Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
l Ptr Word8 -> IO ()
f = do
    ForeignPtr Word8
fp <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes Int
l
    ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> IO ()
f Ptr Word8
p
#if MIN_VERSION_bytestring(0,11,0)
    ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! ForeignPtr Word8 -> Int -> ByteString
BI.BS ForeignPtr Word8
fp Int
l
#else
    return $! BI.PS fp 0 l
#endif
{-# INLINE create #-}