-- |
-- Module      : Data.ByteArray.View
-- License     : BSD-style
-- Maintainer  : Nicolas DI PRIMA <nicolas@di-prima.fr>
-- Stability   : stable
-- Portability : Good
--
-- a View on a given ByteArrayAccess
--

module Data.ByteArray.View
    ( View
    , view
    , takeView
    , dropView
    ) where

import Data.ByteArray.Methods
import Data.ByteArray.Types
import Data.Memory.PtrMethods
import Data.Memory.Internal.Compat
import Foreign.Ptr (plusPtr)

import Prelude hiding (length, take, drop)

-- | a view on a given bytes
--
-- Equality test in constant time
data View bytes = View
    { View bytes -> Int
viewOffset :: !Int
    , View bytes -> Int
viewSize   :: !Int
    , View bytes -> bytes
unView     :: !bytes
    }

instance ByteArrayAccess bytes => Eq (View bytes) where
    == :: View bytes -> View bytes -> Bool
(==) = View bytes -> View bytes -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
constEq

instance ByteArrayAccess bytes => Ord (View bytes) where
    compare :: View bytes -> View bytes -> Ordering
compare View bytes
v1 View bytes
v2 = IO Ordering -> Ordering
forall a. IO a -> a
unsafeDoIO (IO Ordering -> Ordering) -> IO Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$
        View bytes -> (Ptr Word8 -> IO Ordering) -> IO Ordering
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray View bytes
v1 ((Ptr Word8 -> IO Ordering) -> IO Ordering)
-> (Ptr Word8 -> IO Ordering) -> IO Ordering
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr1 ->
        View bytes -> (Ptr Word8 -> IO Ordering) -> IO Ordering
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray View bytes
v2 ((Ptr Word8 -> IO Ordering) -> IO Ordering)
-> (Ptr Word8 -> IO Ordering) -> IO Ordering
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr2 -> do
            Ordering
ret <- Ptr Word8 -> Ptr Word8 -> Int -> IO Ordering
memCompare Ptr Word8
ptr1 Ptr Word8
ptr2 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (View bytes -> Int
forall bytes. View bytes -> Int
viewSize View bytes
v1) (View bytes -> Int
forall bytes. View bytes -> Int
viewSize View bytes
v2))
            Ordering -> IO Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return (Ordering -> IO Ordering) -> Ordering -> IO Ordering
forall a b. (a -> b) -> a -> b
$ case Ordering
ret of
                Ordering
EQ | View bytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
length View bytes
v1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>  View bytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
length View bytes
v2 -> Ordering
GT
                   | View bytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
length View bytes
v1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  View bytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
length View bytes
v2 -> Ordering
LT
                   | View bytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
length View bytes
v1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== View bytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
length View bytes
v2 -> Ordering
EQ
                Ordering
_                           -> Ordering
ret

instance ByteArrayAccess bytes => Show (View bytes) where
    showsPrec :: Int -> View bytes -> ShowS
showsPrec Int
p View bytes
v String
r = Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (View bytes -> ShowS
forall bytes. ByteArrayAccess bytes => View bytes -> ShowS
viewUnpackChars View bytes
v []) String
r

instance ByteArrayAccess bytes => ByteArrayAccess (View bytes) where
    length :: View bytes -> Int
length = View bytes -> Int
forall bytes. View bytes -> Int
viewSize
    withByteArray :: View bytes -> (Ptr p -> IO a) -> IO a
withByteArray View bytes
v Ptr p -> IO a
f = bytes -> (Ptr Any -> IO a) -> IO a
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray (View bytes -> bytes
forall bytes. View bytes -> bytes
unView View bytes
v) ((Ptr Any -> IO a) -> IO a) -> (Ptr Any -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Any
ptr -> Ptr p -> IO a
f (Ptr Any
ptr Ptr Any -> Int -> Ptr p
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (View bytes -> Int
forall bytes. View bytes -> Int
viewOffset View bytes
v))

viewUnpackChars :: ByteArrayAccess bytes
                => View bytes
                -> String
                -> String
viewUnpackChars :: View bytes -> ShowS
viewUnpackChars View bytes
v String
xs = Int -> String
chunkLoop Int
0
  where
    len :: Int
len = View bytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
length View bytes
v

    chunkLoop :: Int -> [Char]
    chunkLoop :: Int -> String
chunkLoop Int
idx
        | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
idx = []
        | (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
idx) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
63 =
            Int -> Int -> ShowS
bytesLoop Int
idx (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
64) (Int -> String
chunkLoop (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
64))
        | Bool
otherwise =
            Int -> Int -> ShowS
bytesLoop Int
idx (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
idx) String
xs

    bytesLoop :: Int -> Int -> [Char] -> [Char]
    bytesLoop :: Int -> Int -> ShowS
bytesLoop Int
idx Int
chunkLenM1 String
paramAcc =
        Int -> ShowS
loop (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
chunkLenM1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
paramAcc
      where
        loop :: Int -> ShowS
loop Int
i String
acc
            | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
idx  = (Int -> Char
rChar Int
i Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc)
            | Bool
otherwise = Int -> ShowS
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> Char
rChar Int
i Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc)

    rChar :: Int -> Char
    rChar :: Int -> Char
rChar Int
idx = Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ View bytes -> Int -> Word8
forall a. ByteArrayAccess a => a -> Int -> Word8
index View bytes
v Int
idx

-- | create a view on a given bytearray
--
-- This function update the offset and the size in order to guarantee:
--
-- * offset >= 0
-- * size >= 0
-- * offset < length
-- * size =< length - offset
--
view :: ByteArrayAccess bytes
     => bytes -- ^ the byte array we put a view on
     -> Int   -- ^ the offset to start the byte array on
     -> Int   -- ^ the size of the view
     -> View bytes
view :: bytes -> Int -> Int -> View bytes
view bytes
b Int
offset'' Int
size'' = Int -> Int -> bytes -> View bytes
forall bytes. Int -> Int -> bytes -> View bytes
View Int
offset Int
size bytes
b
  where
    -- make sure offset is not negative
    offset' :: Int
    offset' :: Int
offset' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
offset'' Int
0

    -- make sure the offset is not out of bound
    offset :: Int
    offset :: Int
offset = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
offset' (bytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
length bytes
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

    -- make sure length is not negative
    size' :: Int
    size' :: Int
size' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
size'' Int
0

    -- make sure the length is not out of the bound
    size :: Int
    size :: Int
size = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
size' (bytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
length bytes
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset)

-- | create a view from the given bytearray
takeView :: ByteArrayAccess bytes
         => bytes -- ^ byte aray
         -> Int   -- ^ size of the view
         -> View bytes
takeView :: bytes -> Int -> View bytes
takeView bytes
b Int
size = bytes -> Int -> Int -> View bytes
forall bytes.
ByteArrayAccess bytes =>
bytes -> Int -> Int -> View bytes
view bytes
b Int
0 Int
size

-- | create a view from the given byte array
-- starting after having dropped the fist n bytes
dropView :: ByteArrayAccess bytes
         => bytes -- ^ byte array
         -> Int   -- ^ the number of bytes do dropped before creating the view
         -> View bytes
dropView :: bytes -> Int -> View bytes
dropView bytes
b Int
offset = bytes -> Int -> Int -> View bytes
forall bytes.
ByteArrayAccess bytes =>
bytes -> Int -> Int -> View bytes
view bytes
b Int
offset (bytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
length bytes
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset)