module Sound.MED.Basic.ByteString where

import qualified Data.ByteString as B

import Data.Bits (Bits, shiftL, (.|.))
import Data.Word (Word8, Word16, Word32)
import Data.Int (Int8, Int16, Int32)


type PTR = Word32
type Peek a = B.ByteString -> PTR -> a


peekInt32 :: Peek Int32; peekInt32 :: Peek Int32
peekInt32 ByteString
xs = Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int32) -> (Word32 -> Word32) -> Word32 -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peek Word32
peekWord32 ByteString
xs
peekInt16 :: Peek Int16; peekInt16 :: Peek Int16
peekInt16 ByteString
xs = Word16 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int16) -> (Word32 -> Word16) -> Word32 -> Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peek Word16
peekWord16 ByteString
xs
peekInt8  :: Peek Int8;  peekInt8 :: Peek Int8
peekInt8  ByteString
xs = Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int8) -> (Word32 -> Word8) -> Word32 -> Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peek Word8
peekWord8  ByteString
xs

peekWord32 :: Peek Word32
peekWord32 :: Peek Word32
peekWord32 ByteString
xs Word32
ptr =
  let k :: Int
k = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
ptr
  in  ByteString -> Int -> Int -> Word32
forall a. (Bits a, Num a) => ByteString -> Int -> Int -> a
peekOffset ByteString
xs Int
k Int
0 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
<+ ByteString -> Int -> Int -> Word32
forall a. (Bits a, Num a) => ByteString -> Int -> Int -> a
peekOffset ByteString
xs Int
k Int
1 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
<+
      ByteString -> Int -> Int -> Word32
forall a. (Bits a, Num a) => ByteString -> Int -> Int -> a
peekOffset ByteString
xs Int
k Int
2 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
<+ ByteString -> Int -> Int -> Word32
forall a. (Bits a, Num a) => ByteString -> Int -> Int -> a
peekOffset ByteString
xs Int
k Int
3

peekWord16 :: Peek Word16
peekWord16 :: Peek Word16
peekWord16 ByteString
xs Word32
ptr =
  let k :: Int
k = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
ptr
  in  ByteString -> Int -> Int -> Word16
forall a. (Bits a, Num a) => ByteString -> Int -> Int -> a
peekOffset ByteString
xs Int
k Int
0 Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
<+ ByteString -> Int -> Int -> Word16
forall a. (Bits a, Num a) => ByteString -> Int -> Int -> a
peekOffset ByteString
xs Int
k Int
1

infixl 6 <+
(<+) :: (Bits a) => a -> a -> a
a
x <+ :: a -> a -> a
<+ a
y = a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL a
x Int
8 a -> a -> a
forall a. Bits a => a -> a -> a
.|. a
y

peekOffset :: (Bits a, Num a) => B.ByteString -> Int -> Int -> a
peekOffset :: ByteString -> Int -> Int -> a
peekOffset ByteString
xs Int
k Int
d = Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> a) -> Word8 -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> Word8
B.index ByteString
xs (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d

peekWord8 :: Peek Word8
peekWord8 :: Peek Word8
peekWord8 ByteString
xs Word32
k = ByteString -> Int -> Word8
B.index ByteString
xs (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
k