-- | 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 Optics.Extra.Internal.ByteString
  ( traversedStrictTree
  , traversedStrictTree8
  , traversedLazy
  , traversedLazy8
  ) where

import Data.Bits
import Data.Char
import Data.Int
import Data.Word
import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.Storable
import GHC.Base (unsafeChr)
import GHC.ForeignPtr (mallocPlainForeignPtrBytes)
import GHC.IO (unsafeDupablePerformIO)
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.Profunctor.Indexed

import Optics.Core
import Optics.Internal.Fold
import Optics.Internal.IxFold
import Optics.Internal.Optic

-- | Traverse a strict 'B.ByteString' in a relatively balanced fashion, as a
-- balanced tree with biased runs of elements at the leaves.
traversedStrictTree :: IxTraversal' Int64 B.ByteString Word8
traversedStrictTree :: IxTraversal' Int64 ByteString Word8
traversedStrictTree = (forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_
   A_Traversal
   p
   i
   (Curry (WithIx Int64) i)
   ByteString
   ByteString
   Word8
   Word8)
-> IxTraversal' Int64 ByteString Word8
forall k (is :: IxList) s t a b.
(forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ k p i (Curry is i) s t a b)
-> Optic k is s t a b
Optic forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_
  A_Traversal
  p
  i
  (Curry (WithIx Int64) i)
  ByteString
  ByteString
  Word8
  Word8
forall (p :: * -> * -> * -> *) j.
Traversing p =>
Optic__ p j (Int64 -> j) ByteString ByteString Word8 Word8
traversedStrictTree__
{-# INLINE traversedStrictTree #-}

-- | 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 :: IxTraversal' Int64 B8.ByteString Char
traversedStrictTree8 :: IxTraversal' Int64 ByteString Char
traversedStrictTree8 = (forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_
   A_Traversal
   p
   i
   (Curry (WithIx Int64) i)
   ByteString
   ByteString
   Char
   Char)
-> IxTraversal' Int64 ByteString Char
forall k (is :: IxList) s t a b.
(forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ k p i (Curry is i) s t a b)
-> Optic k is s t a b
Optic forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_
  A_Traversal
  p
  i
  (Curry (WithIx Int64) i)
  ByteString
  ByteString
  Char
  Char
forall (p :: * -> * -> * -> *) j.
Traversing p =>
Optic__ p j (Int64 -> j) ByteString ByteString Char Char
traversedStrictTree8__
{-# INLINE traversedStrictTree8 #-}

-- | An 'IxTraversal' of the individual bytes in a lazy 'BL.ByteString'.
traversedLazy :: IxTraversal' Int64 BL.ByteString Word8
traversedLazy :: IxTraversal' Int64 ByteString Word8
traversedLazy = (forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_
   A_Traversal
   p
   i
   (Curry (WithIx Int64) i)
   ByteString
   ByteString
   Word8
   Word8)
-> IxTraversal' Int64 ByteString Word8
forall k (is :: IxList) s t a b.
(forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ k p i (Curry is i) s t a b)
-> Optic k is s t a b
Optic forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_
  A_Traversal
  p
  i
  (Curry (WithIx Int64) i)
  ByteString
  ByteString
  Word8
  Word8
forall (p :: * -> * -> * -> *) j.
Traversing p =>
Optic__ p j (Int64 -> j) ByteString ByteString Word8 Word8
traversedLazy__
{-# INLINE traversedLazy #-}

-- | An 'IxTraversal' of the individual bytes in a lazy 'BL.ByteString'
-- pretending the bytes are chars.
traversedLazy8 :: IxTraversal' Int64 BL.ByteString Char
traversedLazy8 :: IxTraversal' Int64 ByteString Char
traversedLazy8 = (forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_
   A_Traversal
   p
   i
   (Curry (WithIx Int64) i)
   ByteString
   ByteString
   Char
   Char)
-> IxTraversal' Int64 ByteString Char
forall k (is :: IxList) s t a b.
(forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ k p i (Curry is i) s t a b)
-> Optic k is s t a b
Optic forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_
  A_Traversal
  p
  i
  (Curry (WithIx Int64) i)
  ByteString
  ByteString
  Char
  Char
forall (p :: * -> * -> * -> *) j.
Traversing p =>
Optic__ p j (Int64 -> j) ByteString ByteString Char Char
traversedLazy8__
{-# INLINE traversedLazy8 #-}

----------------------------------------
-- Internal implementations

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

-- | Internal version of 'traversedStrictTree'.
traversedStrictTree__
  :: Traversing p
  => Optic__ p j (Int64 -> j) B.ByteString B.ByteString Word8 Word8
traversedStrictTree__ :: Optic__ p j (Int64 -> j) ByteString ByteString Word8 Word8
traversedStrictTree__ = (forall (f :: * -> *).
 Applicative f =>
 (Int64 -> Word8 -> f Word8) -> ByteString -> f ByteString)
-> Optic__ p j (Int64 -> j) ByteString ByteString Word8 Word8
forall (p :: * -> * -> * -> *) i a b s t j.
Traversing p =>
(forall (f :: * -> *).
 Applicative f =>
 (i -> a -> f b) -> s -> f t)
-> p j a b -> p (i -> j) s t
iwander ((forall (f :: * -> *).
  Applicative f =>
  (Int64 -> Word8 -> f Word8) -> ByteString -> f ByteString)
 -> Optic__ p j (Int64 -> j) ByteString ByteString Word8 Word8)
-> (forall (f :: * -> *).
    Applicative f =>
    (Int64 -> Word8 -> f Word8) -> ByteString -> f ByteString)
-> Optic__ p j (Int64 -> j) ByteString ByteString Word8 Word8
forall a b. (a -> b) -> a -> b
$ \Int64 -> Word8 -> f Word8
f ByteString
bs ->
  let len :: Int
len = ByteString -> Int
B.length ByteString
bs
      go :: Int64 -> Int64 -> f (Ptr Word8 -> IO ())
go !Int64
i !Int64
j
        | Int64
i Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
grain Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
j, Int64
k <- Int64
i Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
shiftR (Int64
j Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
i) Int
1 =
            (\Ptr Word8 -> IO ()
l Ptr Word8 -> IO ()
r Ptr Word8
q -> Ptr Word8 -> IO ()
l Ptr Word8
q IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Word8 -> IO ()
r Ptr Word8
q) ((Ptr Word8 -> IO ())
 -> (Ptr Word8 -> IO ()) -> Ptr Word8 -> IO ())
-> f (Ptr Word8 -> IO ())
-> f ((Ptr Word8 -> IO ()) -> Ptr Word8 -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> Int64 -> f (Ptr Word8 -> IO ())
go Int64
i Int64
k f ((Ptr Word8 -> IO ()) -> Ptr Word8 -> IO ())
-> f (Ptr Word8 -> IO ()) -> f (Ptr Word8 -> IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int64 -> Int64 -> f (Ptr Word8 -> IO ())
go Int64
k Int64
j
        | Bool
otherwise = Int64 -> Int64 -> f (Ptr Word8 -> IO ())
run Int64
i Int64
j
      run :: Int64 -> Int64 -> f (Ptr Word8 -> IO ())
run !(Int64
i::Int64) !(Int64
j::Int64)
        | Int64
i Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
j    = (Ptr Word8 -> IO ()) -> f (Ptr Word8 -> IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\Ptr Word8
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        | Bool
otherwise =
          let !i' :: Int
i' = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
              !x :: Word8
x  = ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
i'
          in (\Word8
y Ptr Word8 -> IO ()
ys Ptr Word8
q -> Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
q Int
i' Word8
y IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Word8 -> IO ()
ys Ptr Word8
q)
               (Word8 -> (Ptr Word8 -> IO ()) -> Ptr Word8 -> IO ())
-> f Word8 -> f ((Ptr Word8 -> IO ()) -> Ptr Word8 -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> Word8 -> f Word8
f Int64
i Word8
x
               f ((Ptr Word8 -> IO ()) -> Ptr Word8 -> IO ())
-> f (Ptr Word8 -> IO ()) -> f (Ptr Word8 -> IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int64 -> Int64 -> f (Ptr Word8 -> IO ())
run (Int64
i Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1) Int64
j
  in 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
<$> Int64 -> Int64 -> f (Ptr Word8 -> IO ())
go Int64
0 (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
{-# INLINE [0] traversedStrictTree__ #-}

{-# RULES

"bytes -> map"
  forall (o :: FunArrow j Word8 Word8). traversedStrictTree__ o
                                      = roam B.map (reFunArrow o)
    :: FunArrow (Int64 -> j) B.ByteString B.ByteString

"bytes -> imap"
  forall (o :: IxFunArrow j Word8 Word8). traversedStrictTree__ o = iroam imapB o
    :: IxFunArrow (Int64 -> j) B.ByteString B.ByteString

"bytes -> foldr"
  forall (o :: Forget r j Word8 Word8). traversedStrictTree__ o
                                      = foldring__ B.foldr (reForget o)
    :: Forget r (Int64 -> j) B.ByteString B.ByteString

"bytes -> ifoldr"
  forall (o :: IxForget r j Word8 Word8). traversedStrictTree__ o
                                        = ifoldring__ ifoldrB o
    :: IxForget r (Int64 -> j) B.ByteString B.ByteString

#-}

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

-- | Indexed fold for 'traversedStrictTree__'.
ifoldrB :: (Int64 -> Word8 -> a -> a) -> a -> B.ByteString -> a
ifoldrB :: (Int64 -> Word8 -> a -> a) -> a -> ByteString -> a
ifoldrB Int64 -> Word8 -> a -> a
f a
z ByteString
xs = (Word8 -> (Int64 -> a) -> Int64 -> a)
-> (Int64 -> a) -> ByteString -> Int64 -> a
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
B.foldr (\Word8
x Int64 -> a
g Int64
i -> Int64
i Int64 -> a -> a
`seq` Int64 -> Word8 -> a -> a
f Int64
i Word8
x (Int64 -> a
g (Int64
i Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1))) (a -> Int64 -> a
forall a b. a -> b -> a
const a
z) ByteString
xs Int64
0
{-# INLINE ifoldrB #-}

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

-- | Internal version of 'traversedStrictTree8'.
traversedStrictTree8__
  :: Traversing p
  => Optic__ p j (Int64 -> j) B8.ByteString B8.ByteString Char Char
traversedStrictTree8__ :: Optic__ p j (Int64 -> j) ByteString ByteString Char Char
traversedStrictTree8__ = (forall (f :: * -> *).
 Applicative f =>
 (Int64 -> Char -> f Char) -> ByteString -> f ByteString)
-> Optic__ p j (Int64 -> j) ByteString ByteString Char Char
forall (p :: * -> * -> * -> *) i a b s t j.
Traversing p =>
(forall (f :: * -> *).
 Applicative f =>
 (i -> a -> f b) -> s -> f t)
-> p j a b -> p (i -> j) s t
iwander ((forall (f :: * -> *).
  Applicative f =>
  (Int64 -> Char -> f Char) -> ByteString -> f ByteString)
 -> Optic__ p j (Int64 -> j) ByteString ByteString Char Char)
-> (forall (f :: * -> *).
    Applicative f =>
    (Int64 -> Char -> f Char) -> ByteString -> f ByteString)
-> Optic__ p j (Int64 -> j) ByteString ByteString Char Char
forall a b. (a -> b) -> a -> b
$ \Int64 -> Char -> f Char
f ByteString
bs ->
  let len :: Int
len = ByteString -> Int
B.length ByteString
bs
      go :: Int64 -> Int64 -> f (Ptr Word8 -> IO ())
go !Int64
i !Int64
j
        | Int64
i Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
grain Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
j, Int64
k <- Int64
i Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
shiftR (Int64
j Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
i) Int
1 =
            (\Ptr Word8 -> IO ()
l Ptr Word8 -> IO ()
r Ptr Word8
q -> Ptr Word8 -> IO ()
l Ptr Word8
q IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Word8 -> IO ()
r Ptr Word8
q) ((Ptr Word8 -> IO ())
 -> (Ptr Word8 -> IO ()) -> Ptr Word8 -> IO ())
-> f (Ptr Word8 -> IO ())
-> f ((Ptr Word8 -> IO ()) -> Ptr Word8 -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> Int64 -> f (Ptr Word8 -> IO ())
go Int64
i Int64
k f ((Ptr Word8 -> IO ()) -> Ptr Word8 -> IO ())
-> f (Ptr Word8 -> IO ()) -> f (Ptr Word8 -> IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int64 -> Int64 -> f (Ptr Word8 -> IO ())
go Int64
k Int64
j
        | Bool
otherwise = Int64 -> Int64 -> f (Ptr Word8 -> IO ())
run Int64
i Int64
j
      run :: Int64 -> Int64 -> f (Ptr Word8 -> IO ())
run !(Int64
i::Int64) !(Int64
j::Int64)
        | Int64
i Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
j    = (Ptr Word8 -> IO ()) -> f (Ptr Word8 -> IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\Ptr Word8
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        | Bool
otherwise =
          let !i' :: Int
i' = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
i
              !x :: Word8
x  = ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
i'
          in (\Char
y Ptr Word8 -> IO ()
ys Ptr Word8
q -> Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
q Int
i' (Char -> Word8
c2w Char
y) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Word8 -> IO ()
ys Ptr Word8
q)
               (Char -> (Ptr Word8 -> IO ()) -> Ptr Word8 -> IO ())
-> f Char -> f ((Ptr Word8 -> IO ()) -> Ptr Word8 -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> Char -> f Char
f Int64
i (Word8 -> Char
w2c Word8
x)
               f ((Ptr Word8 -> IO ()) -> Ptr Word8 -> IO ())
-> f (Ptr Word8 -> IO ()) -> f (Ptr Word8 -> IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int64 -> Int64 -> f (Ptr Word8 -> IO ())
run (Int64
i Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1) Int64
j
  in 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
<$> Int64 -> Int64 -> f (Ptr Word8 -> IO ())
go Int64
0 (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
{-# INLINE [0] traversedStrictTree8__ #-}

{-# RULES

"chars -> map"
  forall (o :: FunArrow j Char Char). traversedStrictTree8__ o
                                    = roam B8.map (reFunArrow o)
    :: FunArrow (Int64 -> j) B8.ByteString B8.ByteString

"chars -> imap"
  forall (o :: IxFunArrow j Char Char). traversedStrictTree8__ o = iroam imapB8 o
    :: IxFunArrow (Int64 -> j) B8.ByteString B8.ByteString

"chars -> foldr"
  forall (o :: Forget r j Char Char). traversedStrictTree8__ o
                                    = foldring__ B8.foldr (reForget o)
    :: Forget r (Int64 -> j) B8.ByteString B8.ByteString

"chars -> ifoldr"
  forall (o :: IxForget r j Char Char). traversedStrictTree8__ o
                                      = ifoldring__ ifoldrB8 o
    :: IxForget r (Int64 -> j) B8.ByteString B8.ByteString

#-}

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

-- | Indexed fold for 'traversedStrictTree8__'.
ifoldrB8 :: (Int64 -> Char -> a -> a) -> a -> B.ByteString -> a
ifoldrB8 :: (Int64 -> Char -> a -> a) -> a -> ByteString -> a
ifoldrB8 Int64 -> Char -> a -> a
f a
z ByteString
xs = (Char -> (Int64 -> a) -> Int64 -> a)
-> (Int64 -> a) -> ByteString -> Int64 -> a
forall a. (Char -> a -> a) -> a -> ByteString -> a
B8.foldr (\Char
x Int64 -> a
g Int64
i -> Int64
i Int64 -> a -> a
`seq` Int64 -> Char -> a -> a
f Int64
i Char
x (Int64 -> a
g (Int64
i Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1))) (a -> Int64 -> a
forall a b. a -> b -> a
const a
z) ByteString
xs Int64
0
{-# INLINE ifoldrB8 #-}

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

-- | Internal version of 'traversedLazy'.
traversedLazy__
  :: Traversing p
  => Optic__ p j (Int64 -> j) BL.ByteString BL.ByteString Word8 Word8
traversedLazy__ :: Optic__ p j (Int64 -> j) ByteString ByteString Word8 Word8
traversedLazy__ = (forall (f :: * -> *).
 Applicative f =>
 (Int64 -> Word8 -> f Word8) -> ByteString -> f ByteString)
-> Optic__ p j (Int64 -> j) ByteString ByteString Word8 Word8
forall (p :: * -> * -> * -> *) i a b s t j.
Traversing p =>
(forall (f :: * -> *).
 Applicative f =>
 (i -> a -> f b) -> s -> f t)
-> p j a b -> p (i -> j) s t
iwander ((forall (f :: * -> *).
  Applicative f =>
  (Int64 -> Word8 -> f Word8) -> ByteString -> f ByteString)
 -> Optic__ p j (Int64 -> j) ByteString ByteString Word8 Word8)
-> (forall (f :: * -> *).
    Applicative f =>
    (Int64 -> Word8 -> f Word8) -> ByteString -> f ByteString)
-> Optic__ p j (Int64 -> j) ByteString ByteString Word8 Word8
forall a b. (a -> b) -> a -> b
$ \Int64 -> Word8 -> f Word8
f ByteString
lbs ->
  let go :: ByteString -> (Int64 -> f ByteString) -> Int64 -> f ByteString
go ByteString
c Int64 -> f ByteString
fcs Int64
acc =
        let !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)
            rest :: IxTraversal' Int64 ByteString Word8
rest = (Int64 -> Int64)
-> IxTraversal' Int64 ByteString Word8
-> IxTraversal' Int64 ByteString Word8
forall (is :: IxList) i j k s t a b.
HasSingleIndex is i =>
(i -> j) -> Optic k is s t a b -> Optic k (WithIx j) s t a b
reindexed (\Int64
x -> Int64
acc Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
x) IxTraversal' Int64 ByteString Word8
traversedStrictTree
        in 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
<$> IxTraversal' Int64 ByteString Word8
-> (Int64 -> Word8 -> f Word8) -> ByteString -> f ByteString
forall k (f :: * -> *) (is :: IxList) i s t a b.
(Is k A_Traversal, Applicative f, HasSingleIndex is i) =>
Optic k is s t a b -> (i -> a -> f b) -> s -> f t
itraverseOf IxTraversal' Int64 ByteString Word8
rest Int64 -> Word8 -> f Word8
f ByteString
c f (ByteString -> ByteString) -> f ByteString -> f ByteString
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int64 -> f ByteString
fcs Int64
acc'
  in (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 (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
BL.empty) ByteString
lbs Int64
0
{-# INLINE [1] traversedLazy__ #-}

{-# RULES

"sets lazy bytestring"
  forall (o :: FunArrow j Word8 Word8). traversedLazy__ o
                                      = roam BL.map (reFunArrow o)
    :: FunArrow (Int64 -> j) BL.ByteString BL.ByteString

"isets lazy bytestring"
  forall (o :: IxFunArrow j Word8 Word8). traversedLazy__ o = iroam imapBL o
    :: IxFunArrow (Int64 -> j) BL.ByteString BL.ByteString

"gets lazy bytestring"
  forall (o :: Forget r j Word8 Word8). traversedLazy__ o
                                      = foldring__ BL.foldr (reForget o)
    :: Forget r (Int64 -> j) BL.ByteString BL.ByteString

"igets lazy bytestring"
  forall (o :: IxForget r j Word8 Word8). traversedLazy__ o = ifoldring__ ifoldrBL o
    :: IxForget r (Int64 -> j) BL.ByteString BL.ByteString

#-}

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

-- | Indexed fold for 'traversedLazy__'.
ifoldrBL :: (Int64 -> Word8 -> a -> a) -> a -> BL.ByteString -> a
ifoldrBL :: (Int64 -> Word8 -> a -> a) -> a -> ByteString -> a
ifoldrBL Int64 -> Word8 -> a -> a
f a
z ByteString
xs = (Word8 -> (Int64 -> a) -> Int64 -> a)
-> (Int64 -> a) -> ByteString -> Int64 -> a
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
BL.foldr (\Word8
x Int64 -> a
g Int64
i -> Int64
i Int64 -> a -> a
`seq` Int64 -> Word8 -> a -> a
f Int64
i Word8
x (Int64 -> a
g (Int64
i Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1))) (a -> Int64 -> a
forall a b. a -> b -> a
const a
z) ByteString
xs Int64
0
{-# INLINE ifoldrBL #-}

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

-- | Internal version of 'traversedLazy8'.
traversedLazy8__
  :: Traversing p
  => Optic__ p j (Int64 -> j) BL.ByteString BL.ByteString Char Char
traversedLazy8__ :: Optic__ p j (Int64 -> j) ByteString ByteString Char Char
traversedLazy8__ = (forall (f :: * -> *).
 Applicative f =>
 (Int64 -> Char -> f Char) -> ByteString -> f ByteString)
-> Optic__ p j (Int64 -> j) ByteString ByteString Char Char
forall (p :: * -> * -> * -> *) i a b s t j.
Traversing p =>
(forall (f :: * -> *).
 Applicative f =>
 (i -> a -> f b) -> s -> f t)
-> p j a b -> p (i -> j) s t
iwander ((forall (f :: * -> *).
  Applicative f =>
  (Int64 -> Char -> f Char) -> ByteString -> f ByteString)
 -> Optic__ p j (Int64 -> j) ByteString ByteString Char Char)
-> (forall (f :: * -> *).
    Applicative f =>
    (Int64 -> Char -> f Char) -> ByteString -> f ByteString)
-> Optic__ p j (Int64 -> j) ByteString ByteString Char Char
forall a b. (a -> b) -> a -> b
$ \Int64 -> Char -> f Char
f ByteString
lbs ->
  let go :: ByteString -> (Int64 -> f ByteString) -> Int64 -> f ByteString
go ByteString
c Int64 -> f ByteString
fcs Int64
acc =
        let !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)
            rest :: IxTraversal' Int64 ByteString Char
rest = (Int64 -> Int64)
-> IxTraversal' Int64 ByteString Char
-> IxTraversal' Int64 ByteString Char
forall (is :: IxList) i j k s t a b.
HasSingleIndex is i =>
(i -> j) -> Optic k is s t a b -> Optic k (WithIx j) s t a b
reindexed (\Int64
x -> Int64
acc Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
x) IxTraversal' Int64 ByteString Char
traversedStrictTree8
        in 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
<$> IxTraversal' Int64 ByteString Char
-> (Int64 -> Char -> f Char) -> ByteString -> f ByteString
forall k (f :: * -> *) (is :: IxList) i s t a b.
(Is k A_Traversal, Applicative f, HasSingleIndex is i) =>
Optic k is s t a b -> (i -> a -> f b) -> s -> f t
itraverseOf IxTraversal' Int64 ByteString Char
rest Int64 -> Char -> f Char
f ByteString
c f (ByteString -> ByteString) -> f ByteString -> f ByteString
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int64 -> f ByteString
fcs Int64
acc'
  in (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 (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
BL.empty) ByteString
lbs Int64
0
{-# INLINE [1] traversedLazy8__ #-}

{-# RULES

"sets lazy char bytestring"
  forall (o :: FunArrow j Char Char). traversedLazy8__ o
                                    = roam BL8.map (reFunArrow o)
    :: FunArrow (Int64 -> j) BL8.ByteString BL8.ByteString

"isets lazy char bytestring"
  forall (o :: IxFunArrow j Char Char). traversedLazy8__ o = iroam imapBL8 o
    :: IxFunArrow (Int64 -> j) BL8.ByteString BL8.ByteString

"gets lazy char bytestring"
  forall (o :: Forget r j Char Char). traversedLazy8__ o
                                    = foldring__ BL8.foldr (reForget o)
    :: Forget r (Int64 -> j) BL8.ByteString BL8.ByteString

"igets lazy char bytestring"
  forall (o :: IxForget r j Char Char). traversedLazy8__ o = ifoldring__ ifoldrBL8 o
    :: IxForget r (Int64 -> j) BL.ByteString BL.ByteString

#-}

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

-- | Indexed fold for 'traversedLazy8__'.
ifoldrBL8 :: (Int64 -> Char -> a -> a) -> a -> BL8.ByteString -> a
ifoldrBL8 :: (Int64 -> Char -> a -> a) -> a -> ByteString -> a
ifoldrBL8 Int64 -> Char -> a -> a
f a
z ByteString
xs = (Char -> (Int64 -> a) -> Int64 -> a)
-> (Int64 -> a) -> ByteString -> Int64 -> a
forall a. (Char -> a -> a) -> a -> ByteString -> a
BL8.foldr (\Char
x Int64 -> a
g Int64
i -> Int64
i Int64 -> a -> a
`seq` Int64 -> Char -> a -> a
f Int64
i Char
x (Int64 -> a
g (Int64
i Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1))) (a -> Int64 -> a
forall a b. a -> b -> a
const a
z) ByteString
xs Int64
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
    ByteString -> IO ByteString
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 -> Int -> ByteString
BI.PS ForeignPtr Word8
fp Int
0 Int
l
{-# INLINE create #-}