{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE FlexibleContexts #-}
#ifdef TRUSTWORTHY
{-# LANGUAGE Trustworthy #-}
#endif
#include "lens-common.h"
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.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 #-}
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a. Num a => a -> a -> a
+ Int
grain forall a. Ord a => a -> a -> Bool
< Int
j, Int
k <- Int
i forall a. Num a => a -> a -> a
+ forall a. Bits a => a -> Int -> a
shiftR (Int
j 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr b -> IO ()
r Ptr b
q) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> f (Ptr b -> IO ())
go Int
i Int
k 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 = 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 forall a. Eq a => a -> a -> Bool
== Int
j = forall (f :: * -> *) a. Applicative f => a -> f a
pure (\Ptr b
_ -> 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 -> forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
q Int
i Word8
y forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr b -> IO ()
ys Ptr b
q) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> f (Ptr b -> IO ())
run (Int
i 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 = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall acc.
(acc -> Word8 -> (acc, Word8))
-> acc -> ByteString -> (acc, ByteString)
B.mapAccumL (\Int
i Word8
a -> Int
i seq :: forall a b. a -> b -> b
`seq` (Int
i 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 = forall a. (Word8 -> a -> a) -> a -> ByteString -> a
B.foldr (\ Word8
x Int -> a
g Int
i -> Int
i seq :: forall a b. a -> b -> b
`seq` Int -> Word8 -> a -> a
f Int
i Word8
x (Int -> a
g (Int
iforall a. Num a => a -> a -> a
+Int
1))) (forall a b. a -> b -> a
const a
z) ByteString
xs Int
0
{-# INLINE ifoldrB #-}
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a. Num a => a -> a -> a
+ Int
grain forall a. Ord a => a -> a -> Bool
< Int
j = let k :: Int
k = Int
i forall a. Num a => a -> a -> a
+ forall a. Bits a => a -> Int -> a
shiftR (Int
j 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr b -> IO ()
r Ptr b
q) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> f (Ptr b -> IO ())
go Int
i Int
k 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 = 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 forall a. Eq a => a -> a -> Bool
== Int
j = forall (f :: * -> *) a. Applicative f => a -> f a
pure (\Ptr b
_ -> 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 -> forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr b
q Int
i (Char -> Word8
c2w Char
y) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr b -> IO ()
ys Ptr b
q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> f (Ptr b -> IO ())
run (Int
i 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 = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall acc.
(acc -> Char -> (acc, Char))
-> acc -> ByteString -> (acc, ByteString)
B8.mapAccumL (\Int
i Char
a -> Int
i seq :: forall a b. a -> b -> b
`seq` (Int
i 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 = forall a. (Char -> a -> a) -> a -> ByteString -> a
B8.foldr (\ Char
x Int -> a
g Int
i -> Int
i seq :: forall a b. a -> b -> b
`seq` Int -> Char -> a -> a
f Int
i Char
x (Int -> a
g (Int
iforall a. Num a => a -> a -> a
+Int
1))) (forall a b. a -> b -> a
const a
z) ByteString
xs Int
0
{-# INLINE ifoldrB8 #-}
traversedLazy :: IndexedTraversal' Int64 BL.ByteString Word8
traversedLazy :: IndexedTraversal' Int64 ByteString Word8
traversedLazy p Word8 (f Word8)
pafb = \ByteString
lbs -> forall a. (ByteString -> a -> a) -> a -> ByteString -> a
BL.foldrChunks ByteString -> (Int64 -> f ByteString) -> Int64 -> f ByteString
go (\Int64
_ -> 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x :: Int64) IndexedTraversal' Int ByteString Word8
traversedStrictTree p Word8 (f Word8)
pafb ByteString
c
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 forall a. Num a => a -> a -> a
+ 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;
#-}
imapBL :: (Int -> Word8 -> Word8) -> BL.ByteString -> BL.ByteString
imapBL :: (Int -> Word8 -> Word8) -> ByteString -> ByteString
imapBL Int -> Word8 -> Word8
f = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall acc.
(acc -> Word8 -> (acc, Word8))
-> acc -> ByteString -> (acc, ByteString)
BL.mapAccumL (\Int
i Word8
a -> Int
i seq :: forall a b. a -> b -> b
`seq` (Int
i 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 = forall a. (Word8 -> a -> a) -> a -> ByteString -> a
BL.foldr (\ Word8
x Int -> a
g Int
i -> Int
i seq :: forall a b. a -> b -> b
`seq` Int -> Word8 -> a -> a
f Int
i Word8
x (Int -> a
g (Int
iforall a. Num a => a -> a -> a
+Int
1))) (forall a b. a -> b -> a
const a
z) ByteString
xs Int
0
{-# INLINE ifoldrBL #-}
traversedLazy8 :: IndexedTraversal' Int64 BL.ByteString Char
traversedLazy8 :: IndexedTraversal' Int64 ByteString Char
traversedLazy8 p Char (f Char)
pafb = \ByteString
lbs -> forall a. (ByteString -> a -> a) -> a -> ByteString -> a
BL.foldrChunks ByteString -> (Int64 -> f ByteString) -> Int64 -> f ByteString
go (\Int64
_ -> 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x :: Int64) IndexedTraversal' Int ByteString Char
traversedStrictTree8 p Char (f Char)
pafb ByteString
c
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 forall a. Num a => a -> a -> a
+ 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;
#-}
imapBL8 :: (Int -> Char -> Char) -> BL8.ByteString -> BL8.ByteString
imapBL8 :: (Int -> Char -> Char) -> ByteString -> ByteString
imapBL8 Int -> Char -> Char
f = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall acc.
(acc -> Char -> (acc, Char))
-> acc -> ByteString -> (acc, ByteString)
BL8.mapAccumL (\Int
i Char
a -> Int
i seq :: forall a b. a -> b -> b
`seq` (Int
i 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 = forall a. (Char -> a -> a) -> a -> ByteString -> a
BL8.foldr (\ Char
x Int -> a
g Int
i -> Int
i seq :: forall a b. a -> b -> b
`seq` Int -> Char -> a -> a
f Int
i Char
x (Int -> a
g (Int
iforall a. Num a => a -> a -> a
+Int
1))) (forall a b. a -> b -> a
const a
z) ByteString
xs Int
0
{-# INLINE ifoldrBL8 #-}
w2c :: Word8 -> Char
w2c :: Word8 -> Char
w2c = Int -> Char
unsafeChr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE w2c #-}
c2w :: Char -> Word8
c2w :: Char -> Word8
c2w = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
{-# INLINE c2w #-}
unsafeCreate :: Int -> (Ptr Word8 -> IO ()) -> B.ByteString
unsafeCreate :: Int -> (Ptr Word8 -> IO ()) -> ByteString
unsafeCreate Int
l Ptr Word8 -> IO ()
f = forall a. IO a -> a
unsafeDupablePerformIO (Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
l Ptr Word8 -> IO ()
f)
{-# INLINE unsafeCreate #-}
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 <- forall a. Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes Int
l
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> IO ()
f Ptr Word8
p
#if MIN_VERSION_bytestring(0,11,0)
forall (m :: * -> *) a. Monad m => a -> m a
return 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 #-}