{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
#if __GLASGOW_HASKELL__ >= 710
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE PatternSynonyms #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.ByteString.Lens
-- Copyright   :  (C) 2012-16 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
--
----------------------------------------------------------------------------
module Data.ByteString.Lens
  ( IsByteString(..)
  , unpackedBytes
  , unpackedChars
#if __GLASGOW_HASKELL__ >= 710
  , pattern Bytes
  , pattern Chars
#endif
  ) 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

-- | Traversals for ByteStrings.
class IsByteString t where
  -- | 'Data.ByteString.pack' (or 'Data.ByteString.unpack') a list of bytes into a strict or lazy 'ByteString'.
  --
  -- @
  -- 'Data.ByteString.pack' x ≡ x '^.' 'packedBytes'
  -- 'Data.ByteString.unpack' x ≡ x '^.' 'from' 'packedBytes'
  -- 'packedBytes' ≡ 'from' 'unpackedBytes'
  -- @
  packedBytes :: Iso' [Word8] t

  -- | 'Data.ByteString.Char8.pack' (or 'Data.ByteString.Char8.unpack') a list of characters into a strict or lazy 'ByteString'.
  --
  -- When writing back to the 'ByteString' it is assumed that every 'Char'
  -- lies between @'\x00'@ and @'\xff'@.
  --
  -- @
  -- 'Data.ByteString.Char8.pack' x ≡ x '^.' 'packedChars'
  -- 'Data.ByteString.Char8.unpack' x ≡ x '^.' 'from' 'packedChars'
  -- 'packedChars' ≡ 'from' 'unpackedChars'
  -- @
  packedChars :: Iso' String t

  -- | Traverse each 'Word8' in a strict or lazy 'ByteString'
  --
  --
  -- This 'Traversal' walks each strict 'ByteString' chunk in a tree-like fashion
  -- enable zippers to seek to locations more quickly and accelerate
  -- many monoidal queries, but up to associativity (and constant factors) it is
  -- equivalent to the much slower:
  --
  -- @
  -- 'bytes' ≡ 'unpackedBytes' '.' 'traversed'
  -- @
  --
  -- @
  -- 'anyOf' 'bytes' ('==' 0x80) :: 'ByteString' -> 'Bool'
  -- @
  bytes :: IndexedTraversal' Int t Word8
  bytes = AnIso [Word8] [Word8] t t -> Iso t t [Word8] [Word8]
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso [Word8] [Word8] t t
forall t. IsByteString t => Iso' [Word8] t
packedBytes (([Word8] -> f [Word8]) -> t -> f t)
-> (p Word8 (f Word8) -> [Word8] -> f [Word8])
-> p Word8 (f Word8)
-> t
-> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p Word8 (f Word8) -> [Word8] -> f [Word8]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed
  {-# INLINE bytes #-}

  -- | Traverse the individual bytes in a strict or lazy 'ByteString' as characters.
  --
  -- When writing back to the 'ByteString' it is assumed that every 'Char'
  -- lies between @'\x00'@ and @'\xff'@.
  --
  -- This 'Traversal' walks each strict 'ByteString' chunk in a tree-like fashion
  -- enable zippers to seek to locations more quickly and accelerate
  -- many monoidal queries, but up to associativity (and constant factors) it is
  -- equivalent to the much slower:
  --
  -- @
  -- 'chars' ≡ 'unpackedChars' '.' 'traversed'
  -- @
  --
  -- @
  -- 'anyOf' 'chars' ('==' \'c\') :: 'ByteString' -> 'Bool'
  -- @
  chars :: IndexedTraversal' Int t Char
  chars = AnIso String String t t -> Iso t t String String
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso String String t t
forall t. IsByteString t => Iso' String t
packedChars ((String -> f String) -> t -> f t)
-> (p Char (f Char) -> String -> f String)
-> p Char (f Char)
-> t
-> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p Char (f Char) -> String -> f String
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed
  {-# INLINE chars #-}

-- | 'Data.ByteString.unpack' (or 'Data.ByteString.pack') a 'ByteString' into a list of bytes
--
-- @
-- 'unpackedBytes' ≡ 'from' 'packedBytes'
-- 'Data.ByteString.unpack' x ≡ x '^.' 'unpackedBytes'
-- 'Data.ByteString.pack' x ≡  x '^.' 'from' 'unpackedBytes'
-- @
--
-- @
-- 'unpackedBytes' :: 'Iso'' 'Data.ByteString.ByteString' ['Word8']
-- 'unpackedBytes' :: 'Iso'' 'Data.ByteString.Lazy.ByteString' ['Word8']
-- @
unpackedBytes :: IsByteString t => Iso' t [Word8]
unpackedBytes :: Iso' t [Word8]
unpackedBytes = AnIso [Word8] [Word8] t t -> Iso' t [Word8]
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso [Word8] [Word8] t t
forall t. IsByteString t => Iso' [Word8] t
packedBytes
{-# INLINE unpackedBytes #-}

#if __GLASGOW_HASKELL__ >= 710
pattern $bBytes :: [Word8] -> s
$mBytes :: forall r s.
IsByteString s =>
s -> ([Word8] -> r) -> (Void# -> r) -> r
Bytes b <- (view unpackedBytes -> b) where
  Bytes [Word8]
b = AReview s [Word8] -> [Word8] -> s
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview s [Word8]
forall t. IsByteString t => Iso' t [Word8]
unpackedBytes [Word8]
b

pattern $bChars :: String -> s
$mChars :: forall r s.
IsByteString s =>
s -> (String -> r) -> (Void# -> r) -> r
Chars b <- (view unpackedChars -> b) where
  Chars String
b = AReview s String -> String -> s
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview s String
forall t. IsByteString t => Iso' t String
unpackedChars String
b
#endif

-- | 'Data.ByteString.Char8.unpack' (or 'Data.ByteString.Char8.pack') a list of characters into a strict (or lazy) 'ByteString'
--
-- When writing back to the 'ByteString' it is assumed that every 'Char'
-- lies between @'\x00'@ and @'\xff'@.
--
-- @
-- 'unpackedChars' ≡ 'from' 'packedChars'
-- 'Data.ByteString.Char8.unpack' x ≡ x '^.' 'unpackedChars'
-- 'Data.ByteString.Char8.pack' x ≡ x '^.' 'from' 'unpackedChars'
-- @
--
-- @
-- 'unpackedChars' :: 'Iso'' 'Data.ByteString.ByteString' 'String'
-- 'unpackedChars' :: 'Iso'' 'Data.ByteString.Lazy.ByteString' 'String'
-- @
unpackedChars :: IsByteString t => Iso' t String
unpackedChars :: Iso' t String
unpackedChars = AnIso String String t t -> Iso' t String
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso String String t t
forall t. IsByteString t => Iso' String t
packedChars
{-# INLINE unpackedChars #-}

instance IsByteString Strict.ByteString where
  packedBytes :: p ByteString (f ByteString) -> p [Word8] (f [Word8])
packedBytes = p ByteString (f ByteString) -> p [Word8] (f [Word8])
Iso' [Word8] ByteString
Strict.packedBytes
  {-# INLINE packedBytes #-}
  packedChars :: p ByteString (f ByteString) -> p String (f String)
packedChars = p ByteString (f ByteString) -> p String (f String)
Iso' String ByteString
Strict.packedChars
  {-# INLINE packedChars #-}
  bytes :: p Word8 (f Word8) -> ByteString -> f ByteString
bytes = p Word8 (f Word8) -> ByteString -> f ByteString
IndexedTraversal' Int ByteString Word8
Strict.bytes
  {-# INLINE bytes #-}
  chars :: p Char (f Char) -> ByteString -> f ByteString
chars = p Char (f Char) -> ByteString -> f ByteString
IndexedTraversal' Int ByteString Char
Strict.chars
  {-# INLINE chars #-}

instance IsByteString Lazy.ByteString where
  packedBytes :: p ByteString (f ByteString) -> p [Word8] (f [Word8])
packedBytes = p ByteString (f ByteString) -> p [Word8] (f [Word8])
Iso' [Word8] ByteString
Lazy.packedBytes
  {-# INLINE packedBytes #-}
  packedChars :: p ByteString (f ByteString) -> p String (f String)
packedChars = p ByteString (f ByteString) -> p String (f String)
Iso' String ByteString
Lazy.packedChars
  {-# INLINE packedChars #-}
  bytes :: p Word8 (f Word8) -> ByteString -> f ByteString
bytes = AnIso [Word8] [Word8] ByteString ByteString
-> Iso ByteString ByteString [Word8] [Word8]
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso [Word8] [Word8] ByteString ByteString
forall t. IsByteString t => Iso' [Word8] t
packedBytes (([Word8] -> f [Word8]) -> ByteString -> f ByteString)
-> (p Word8 (f Word8) -> [Word8] -> f [Word8])
-> p Word8 (f Word8)
-> ByteString
-> f ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p Word8 (f Word8) -> [Word8] -> f [Word8]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed
  {-# INLINE bytes #-}
  chars :: p Char (f Char) -> ByteString -> f ByteString
chars = AnIso String String ByteString ByteString
-> Iso ByteString ByteString String String
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso String String ByteString ByteString
forall t. IsByteString t => Iso' String t
packedChars ((String -> f String) -> ByteString -> f ByteString)
-> (p Char (f Char) -> String -> f String)
-> p Char (f Char)
-> ByteString
-> f ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p Char (f Char) -> String -> f String
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed
  {-# INLINE chars #-}