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)
data View bytes = View
{ forall bytes. View bytes -> Int
viewOffset :: !Int
, forall bytes. View bytes -> Int
viewSize :: !Int
, forall bytes. View bytes -> bytes
unView :: !bytes
}
instance ByteArrayAccess bytes => Eq (View bytes) where
== :: 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 = forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray View bytes
v1 forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr1 ->
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray View bytes
v2 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 (forall a. Ord a => a -> a -> a
min (forall bytes. View bytes -> Int
viewSize View bytes
v1) (forall bytes. View bytes -> Int
viewSize View bytes
v2))
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Ordering
ret of
Ordering
EQ | forall ba. ByteArrayAccess ba => ba -> Int
length View bytes
v1 forall a. Ord a => a -> a -> Bool
> forall ba. ByteArrayAccess ba => ba -> Int
length View bytes
v2 -> Ordering
GT
| forall ba. ByteArrayAccess ba => ba -> Int
length View bytes
v1 forall a. Ord a => a -> a -> Bool
< forall ba. ByteArrayAccess ba => ba -> Int
length View bytes
v2 -> Ordering
LT
| forall ba. ByteArrayAccess ba => ba -> Int
length View bytes
v1 forall a. Eq a => a -> a -> Bool
== 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 = forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (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 = forall bytes. View bytes -> Int
viewSize
withByteArray :: forall p a. View bytes -> (Ptr p -> IO a) -> IO a
withByteArray View bytes
v Ptr p -> IO a
f = forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
withByteArray (forall bytes. View bytes -> bytes
unView View bytes
v) forall a b. (a -> b) -> a -> b
$ \Ptr Any
ptr -> Ptr p -> IO a
f (Ptr Any
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (forall bytes. View bytes -> Int
viewOffset View bytes
v))
viewUnpackChars :: ByteArrayAccess bytes
=> View bytes
-> String
-> String
viewUnpackChars :: forall bytes. ByteArrayAccess bytes => View bytes -> ShowS
viewUnpackChars View bytes
v String
xs = Int -> String
chunkLoop Int
0
where
len :: Int
len = forall ba. ByteArrayAccess ba => ba -> Int
length View bytes
v
chunkLoop :: Int -> [Char]
chunkLoop :: Int -> String
chunkLoop Int
idx
| Int
len forall a. Eq a => a -> a -> Bool
== Int
idx = []
| (Int
len forall a. Num a => a -> a -> a
- Int
idx) forall a. Ord a => a -> a -> Bool
> Int
63 =
Int -> Int -> ShowS
bytesLoop Int
idx (Int
idx forall a. Num a => a -> a -> a
+ Int
64) (Int -> String
chunkLoop (Int
idx forall a. Num a => a -> a -> a
+ Int
64))
| Bool
otherwise =
Int -> Int -> ShowS
bytesLoop Int
idx (Int
len 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 forall a. Num a => a -> a -> a
+ Int
chunkLenM1 forall a. Num a => a -> a -> a
- Int
1) String
paramAcc
where
loop :: Int -> ShowS
loop Int
i String
acc
| Int
i forall a. Eq a => a -> a -> Bool
== Int
idx = (Int -> Char
rChar Int
i forall a. a -> [a] -> [a]
: String
acc)
| Bool
otherwise = Int -> ShowS
loop (Int
i forall a. Num a => a -> a -> a
- Int
1) (Int -> Char
rChar Int
i forall a. a -> [a] -> [a]
: String
acc)
rChar :: Int -> Char
rChar :: Int -> Char
rChar Int
idx = forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. ByteArrayAccess a => a -> Int -> Word8
index View bytes
v Int
idx
view :: ByteArrayAccess bytes
=> bytes
-> Int
-> Int
-> View bytes
view :: forall bytes.
ByteArrayAccess bytes =>
bytes -> Int -> Int -> View bytes
view bytes
b Int
offset'' Int
size'' = forall bytes. Int -> Int -> bytes -> View bytes
View Int
offset Int
size bytes
b
where
offset' :: Int
offset' :: Int
offset' = forall a. Ord a => a -> a -> a
max Int
offset'' Int
0
offset :: Int
offset :: Int
offset = forall a. Ord a => a -> a -> a
min Int
offset' (forall ba. ByteArrayAccess ba => ba -> Int
length bytes
b forall a. Num a => a -> a -> a
- Int
1)
size' :: Int
size' :: Int
size' = forall a. Ord a => a -> a -> a
max Int
size'' Int
0
size :: Int
size :: Int
size = forall a. Ord a => a -> a -> a
min Int
size' (forall ba. ByteArrayAccess ba => ba -> Int
length bytes
b forall a. Num a => a -> a -> a
- Int
offset)
takeView :: ByteArrayAccess bytes
=> bytes
-> Int
-> View bytes
takeView :: forall bytes. ByteArrayAccess bytes => bytes -> Int -> View bytes
takeView bytes
b Int
size = forall bytes.
ByteArrayAccess bytes =>
bytes -> Int -> Int -> View bytes
view bytes
b Int
0 Int
size
dropView :: ByteArrayAccess bytes
=> bytes
-> Int
-> View bytes
dropView :: forall bytes. ByteArrayAccess bytes => bytes -> Int -> View bytes
dropView bytes
b Int
offset = forall bytes.
ByteArrayAccess bytes =>
bytes -> Int -> Int -> View bytes
view bytes
b Int
offset (forall ba. ByteArrayAccess ba => ba -> Int
length bytes
b forall a. Num a => a -> a -> a
- Int
offset)