{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE PatternSynonyms #-}
module Data.ByteString.Lens
( IsByteString(..)
, unpackedBytes
, unpackedChars
, pattern Bytes
, pattern Chars
) where
import Control.Lens
import Data.Word (Word8)
import qualified Data.ByteString as Strict
import qualified Data.ByteString.Strict.Lens as Strict
import qualified Data.ByteString.Lazy as Lazy
import qualified Data.ByteString.Lazy.Lens as Lazy
class IsByteString t where
packedBytes :: Iso' [Word8] t
packedChars :: Iso' String t
bytes :: IndexedTraversal' Int t Word8
bytes = forall s t a b. AnIso s t a b -> Iso b a t s
from forall t. IsByteString t => Iso' [Word8] t
packedBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed
{-# INLINE bytes #-}
chars :: IndexedTraversal' Int t Char
chars = forall s t a b. AnIso s t a b -> Iso b a t s
from forall t. IsByteString t => Iso' String t
packedChars forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed
{-# INLINE chars #-}
unpackedBytes :: IsByteString t => Iso' t [Word8]
unpackedBytes :: forall t. IsByteString t => Iso' t [Word8]
unpackedBytes = forall s t a b. AnIso s t a b -> Iso b a t s
from forall t. IsByteString t => Iso' [Word8] t
packedBytes
{-# INLINE unpackedBytes #-}
pattern Bytes :: IsByteString s => [Word8] -> s
pattern $bBytes :: forall s. IsByteString s => [Word8] -> s
$mBytes :: forall {r} {s}.
IsByteString s =>
s -> ([Word8] -> r) -> ((# #) -> r) -> r
Bytes b <- (view unpackedBytes -> b) where
Bytes [Word8]
b = forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review forall t. IsByteString t => Iso' t [Word8]
unpackedBytes [Word8]
b
pattern Chars :: IsByteString s => String -> s
pattern $bChars :: forall s. IsByteString s => String -> s
$mChars :: forall {r} {s}.
IsByteString s =>
s -> (String -> r) -> ((# #) -> r) -> r
Chars b <- (view unpackedChars -> b) where
Chars String
b = forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review forall t. IsByteString t => Iso' t String
unpackedChars String
b
unpackedChars :: IsByteString t => Iso' t String
unpackedChars :: forall t. IsByteString t => Iso' t String
unpackedChars = forall s t a b. AnIso s t a b -> Iso b a t s
from forall t. IsByteString t => Iso' String t
packedChars
{-# INLINE unpackedChars #-}
instance IsByteString Strict.ByteString where
packedBytes :: Iso' [Word8] ByteString
packedBytes = Iso' [Word8] ByteString
Strict.packedBytes
{-# INLINE packedBytes #-}
packedChars :: Iso' String ByteString
packedChars = Iso' String ByteString
Strict.packedChars
{-# INLINE packedChars #-}
bytes :: IndexedTraversal' Int ByteString Word8
bytes = IndexedTraversal' Int ByteString Word8
Strict.bytes
{-# INLINE bytes #-}
chars :: IndexedTraversal' Int ByteString Char
chars = IndexedTraversal' Int ByteString Char
Strict.chars
{-# INLINE chars #-}
instance IsByteString Lazy.ByteString where
packedBytes :: Iso' [Word8] ByteString
packedBytes = Iso' [Word8] ByteString
Lazy.packedBytes
{-# INLINE packedBytes #-}
packedChars :: Iso' String ByteString
packedChars = Iso' String ByteString
Lazy.packedChars
{-# INLINE packedChars #-}
bytes :: IndexedTraversal' Int ByteString Word8
bytes = forall s t a b. AnIso s t a b -> Iso b a t s
from forall t. IsByteString t => Iso' [Word8] t
packedBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed
{-# INLINE bytes #-}
chars :: IndexedTraversal' Int ByteString Char
chars = forall s t a b. AnIso s t a b -> Iso b a t s
from forall t. IsByteString t => Iso' String t
packedChars forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed
{-# INLINE chars #-}