{-# LANGUAGE BangPatterns
           , UnboxedTuples #-}

{- | Functions for parsing binary data.
 -}

module Parser.Lathe.Binary
  ( int8
  , word8

    -- * Big-endian
  , int16BE
  , int32BE
  , int64BE
  , word16BE
  , word32BE
  , word64BE
  , floatBE
  , doubleBE

    -- * Little-endian
  , int16LE
  , int32LE
  , int64LE
  , word16LE
  , word32LE
  , word64LE
  , floatLE
  , doubleLE
  ) where

import qualified Parser.Lathe.Binary.Internal as X
import           Parser.Lathe.Internal

import           Data.ByteString (ByteString)
import           Data.Int
import           Data.Word
import           GHC.Float (castWord32ToFloat, castWord64ToDouble)



{-# INLINE int16LE #-}
-- | Consume 2 bytes into a little-endian 'Int16'.
int16LE :: end -> Parser end Int16
int16LE :: forall end. end -> Parser end Int16
int16LE = Int
-> (ByteString -> (# Res end Int16 #)) -> end -> Parser end Int16
forall e a. Int -> (ByteString -> (# Res e a #)) -> e -> Parser e a
unsafeRead Int
2 ByteString -> (# Res end Int16 #)
forall e. ByteString -> (# Res e Int16 #)
i16LE

{-# INLINE int16BE #-}
-- | Consume 2 bytes into a big-endian 'Int16'.
int16BE :: end -> Parser end Int16
int16BE :: forall end. end -> Parser end Int16
int16BE = Int
-> (ByteString -> (# Res end Int16 #)) -> end -> Parser end Int16
forall e a. Int -> (ByteString -> (# Res e a #)) -> e -> Parser e a
unsafeRead Int
2 ByteString -> (# Res end Int16 #)
forall e. ByteString -> (# Res e Int16 #)
i16BE

{-# INLINE word16LE #-}
-- | Consume 2 bytes into a little-endian 'Word16'.
word16LE :: end -> Parser end Word16
word16LE :: forall end. end -> Parser end Word16
word16LE = Int
-> (ByteString -> (# Res end Word16 #)) -> end -> Parser end Word16
forall e a. Int -> (ByteString -> (# Res e a #)) -> e -> Parser e a
unsafeRead Int
2 ByteString -> (# Res end Word16 #)
forall e. ByteString -> (# Res e Word16 #)
w16LE

{-# INLINE word16BE #-}
-- | Consume 2 bytes into a big-endian 'Word16'.
word16BE :: end -> Parser end Word16
word16BE :: forall end. end -> Parser end Word16
word16BE = Int
-> (ByteString -> (# Res end Word16 #)) -> end -> Parser end Word16
forall e a. Int -> (ByteString -> (# Res e a #)) -> e -> Parser e a
unsafeRead Int
2 ByteString -> (# Res end Word16 #)
forall e. ByteString -> (# Res e Word16 #)
w16BE


i16LE :: ByteString -> (# Res e Int16 #)
i16LE :: forall e. ByteString -> (# Res e Int16 #)
i16LE = \ByteString
b ->
  let !r :: Int16
r = Word16 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Word16
X.w16LE ByteString
b)
  in (# Int16 -> Res e Int16
forall a e. a -> Res e a
Yes Int16
r #)

i16BE :: ByteString -> (# Res e Int16 #)
i16BE :: forall e. ByteString -> (# Res e Int16 #)
i16BE = \ByteString
b ->
  let !r :: Int16
r = Word16 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Word16
X.w16BE ByteString
b)
  in (# Int16 -> Res e Int16
forall a e. a -> Res e a
Yes Int16
r #)

w16LE :: ByteString -> (# Res e Word16 #)
w16LE :: forall e. ByteString -> (# Res e Word16 #)
w16LE = \ByteString
b ->
  let !r :: Word16
r = ByteString -> Word16
X.w16LE ByteString
b
  in (# Word16 -> Res e Word16
forall a e. a -> Res e a
Yes Word16
r #)

w16BE :: ByteString -> (# Res e Word16 #)
w16BE :: forall e. ByteString -> (# Res e Word16 #)
w16BE = \ByteString
b ->
  let !r :: Word16
r = ByteString -> Word16
X.w16BE ByteString
b
  in (# Word16 -> Res e Word16
forall a e. a -> Res e a
Yes Word16
r #)



{-# INLINE int32LE #-}
-- | Consume 4 bytes into a little-endian 'Int32'.
int32LE :: end -> Parser end Int32
int32LE :: forall end. end -> Parser end Int32
int32LE = Int
-> (ByteString -> (# Res end Int32 #)) -> end -> Parser end Int32
forall e a. Int -> (ByteString -> (# Res e a #)) -> e -> Parser e a
unsafeRead Int
4 ByteString -> (# Res end Int32 #)
forall e. ByteString -> (# Res e Int32 #)
i32LE

{-# INLINE int32BE #-}
-- | Consume 4 bytes into a big-endian 'Int32'.
int32BE :: end -> Parser end Int32
int32BE :: forall end. end -> Parser end Int32
int32BE = Int
-> (ByteString -> (# Res end Int32 #)) -> end -> Parser end Int32
forall e a. Int -> (ByteString -> (# Res e a #)) -> e -> Parser e a
unsafeRead Int
4 ByteString -> (# Res end Int32 #)
forall e. ByteString -> (# Res e Int32 #)
i32BE

{-# INLINE word32LE #-}
-- | Consume 4 bytes into a little-endian 'Word32'.
word32LE :: end -> Parser end Word32
word32LE :: forall end. end -> Parser end Word32
word32LE = Int
-> (ByteString -> (# Res end Word32 #)) -> end -> Parser end Word32
forall e a. Int -> (ByteString -> (# Res e a #)) -> e -> Parser e a
unsafeRead Int
4 ByteString -> (# Res end Word32 #)
forall e. ByteString -> (# Res e Word32 #)
w32LE

{-# INLINE word32BE #-}
-- | Consume 4 bytes into a big-endian 'Word32'.
word32BE :: end -> Parser end Word32
word32BE :: forall end. end -> Parser end Word32
word32BE = Int
-> (ByteString -> (# Res end Word32 #)) -> end -> Parser end Word32
forall e a. Int -> (ByteString -> (# Res e a #)) -> e -> Parser e a
unsafeRead Int
4 ByteString -> (# Res end Word32 #)
forall e. ByteString -> (# Res e Word32 #)
w32BE

{-# INLINE floatLE #-}
-- | Consume 4 bytes into a little-endian 'Float'.
floatLE :: end -> Parser end Float
floatLE :: forall end. end -> Parser end Float
floatLE = Int
-> (ByteString -> (# Res end Float #)) -> end -> Parser end Float
forall e a. Int -> (ByteString -> (# Res e a #)) -> e -> Parser e a
unsafeRead Int
4 ByteString -> (# Res end Float #)
forall e. ByteString -> (# Res e Float #)
f32LE

{-# INLINE floatBE #-}
-- | Consume 4 bytes into a big-endian 'Float'.
floatBE :: end -> Parser end Float
floatBE :: forall end. end -> Parser end Float
floatBE = Int
-> (ByteString -> (# Res end Float #)) -> end -> Parser end Float
forall e a. Int -> (ByteString -> (# Res e a #)) -> e -> Parser e a
unsafeRead Int
4 ByteString -> (# Res end Float #)
forall e. ByteString -> (# Res e Float #)
f32BE


i32LE :: ByteString -> (# Res e Int32 #)
i32LE :: forall e. ByteString -> (# Res e Int32 #)
i32LE = \ByteString
b ->
  let !r :: Int32
r = Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Word32
X.w32LE ByteString
b)
  in (# Int32 -> Res e Int32
forall a e. a -> Res e a
Yes Int32
r #)

i32BE :: ByteString -> (# Res e Int32 #)
i32BE :: forall e. ByteString -> (# Res e Int32 #)
i32BE = \ByteString
b ->
  let !r :: Int32
r = Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Word32
X.w32BE ByteString
b)
  in (# Int32 -> Res e Int32
forall a e. a -> Res e a
Yes Int32
r #)

w32LE :: ByteString -> (# Res e Word32 #)
w32LE :: forall e. ByteString -> (# Res e Word32 #)
w32LE = \ByteString
b ->
  let !r :: Word32
r = ByteString -> Word32
X.w32LE ByteString
b
  in (# Word32 -> Res e Word32
forall a e. a -> Res e a
Yes Word32
r #)

w32BE :: ByteString -> (# Res e Word32 #)
w32BE :: forall e. ByteString -> (# Res e Word32 #)
w32BE = \ByteString
b ->
  let !r :: Word32
r = ByteString -> Word32
X.w32BE ByteString
b
  in (# Word32 -> Res e Word32
forall a e. a -> Res e a
Yes Word32
r #)

f32LE :: ByteString -> (# Res e Float #)
f32LE :: forall e. ByteString -> (# Res e Float #)
f32LE = \ByteString
b ->
  let !r :: Float
r = Word32 -> Float
castWord32ToFloat (ByteString -> Word32
X.w32LE ByteString
b)
  in (# Float -> Res e Float
forall a e. a -> Res e a
Yes Float
r #)

f32BE :: ByteString -> (# Res e Float #)
f32BE :: forall e. ByteString -> (# Res e Float #)
f32BE = \ByteString
b ->
  let !r :: Float
r = Word32 -> Float
castWord32ToFloat (ByteString -> Word32
X.w32BE ByteString
b)
  in (# Float -> Res e Float
forall a e. a -> Res e a
Yes Float
r #)



{-# INLINE int64LE #-} 
-- | Consume 8 bytes into a little-endian 'Int64'.
int64LE :: end -> Parser end Int64
int64LE :: forall end. end -> Parser end Int64
int64LE = Int
-> (ByteString -> (# Res end Int64 #)) -> end -> Parser end Int64
forall e a. Int -> (ByteString -> (# Res e a #)) -> e -> Parser e a
unsafeRead Int
8 ByteString -> (# Res end Int64 #)
forall e. ByteString -> (# Res e Int64 #)
i64LE

{-# INLINE int64BE #-}
-- | Consume 8 bytes into a big-endian 'Int64'.
int64BE :: end -> Parser end Int64
int64BE :: forall end. end -> Parser end Int64
int64BE = Int
-> (ByteString -> (# Res end Int64 #)) -> end -> Parser end Int64
forall e a. Int -> (ByteString -> (# Res e a #)) -> e -> Parser e a
unsafeRead Int
8 ByteString -> (# Res end Int64 #)
forall e. ByteString -> (# Res e Int64 #)
i64BE

{-# INLINE word64LE #-}
-- | Consume 8 bytes into a little-endian 'Word64'.
word64LE :: end -> Parser end Word64
word64LE :: forall end. end -> Parser end Word64
word64LE = Int
-> (ByteString -> (# Res end Word64 #)) -> end -> Parser end Word64
forall e a. Int -> (ByteString -> (# Res e a #)) -> e -> Parser e a
unsafeRead Int
8 ByteString -> (# Res end Word64 #)
forall e. ByteString -> (# Res e Word64 #)
w64LE

{-# INLINE word64BE #-}
-- | Consume 8 bytes into a big-endian 'Word64'.
word64BE :: end -> Parser end Word64
word64BE :: forall end. end -> Parser end Word64
word64BE = Int
-> (ByteString -> (# Res end Word64 #)) -> end -> Parser end Word64
forall e a. Int -> (ByteString -> (# Res e a #)) -> e -> Parser e a
unsafeRead Int
8 ByteString -> (# Res end Word64 #)
forall e. ByteString -> (# Res e Word64 #)
w64BE

{-# INLINE doubleLE #-}
-- | Consume 8 bytes into a little-endian 'Double'.
doubleLE :: end -> Parser end Double
doubleLE :: forall end. end -> Parser end Double
doubleLE = Int
-> (ByteString -> (# Res end Double #)) -> end -> Parser end Double
forall e a. Int -> (ByteString -> (# Res e a #)) -> e -> Parser e a
unsafeRead Int
8 ByteString -> (# Res end Double #)
forall e. ByteString -> (# Res e Double #)
f64LE

{-# INLINE doubleBE #-}
-- | Consume 8 bytes into a big-endian 'Double'.
doubleBE :: end -> Parser end Double
doubleBE :: forall end. end -> Parser end Double
doubleBE = Int
-> (ByteString -> (# Res end Double #)) -> end -> Parser end Double
forall e a. Int -> (ByteString -> (# Res e a #)) -> e -> Parser e a
unsafeRead Int
8 ByteString -> (# Res end Double #)
forall e. ByteString -> (# Res e Double #)
f64BE


i64LE :: ByteString -> (# Res e Int64 #)
i64LE :: forall e. ByteString -> (# Res e Int64 #)
i64LE = \ByteString
b ->
  let !r :: Int64
r = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Word64
X.w64LE ByteString
b)
  in (# Int64 -> Res e Int64
forall a e. a -> Res e a
Yes Int64
r #)

i64BE :: ByteString -> (# Res e Int64 #)
i64BE :: forall e. ByteString -> (# Res e Int64 #)
i64BE = \ByteString
b ->
  let !r :: Int64
r = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Word64
X.w64BE ByteString
b)
  in (# Int64 -> Res e Int64
forall a e. a -> Res e a
Yes Int64
r #)

w64LE :: ByteString -> (# Res e Word64 #)
w64LE :: forall e. ByteString -> (# Res e Word64 #)
w64LE = \ByteString
b ->
  let !r :: Word64
r = Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Word64
X.w64LE ByteString
b)
  in (# Word64 -> Res e Word64
forall a e. a -> Res e a
Yes Word64
r #)

w64BE :: ByteString -> (# Res e Word64 #)
w64BE :: forall e. ByteString -> (# Res e Word64 #)
w64BE = \ByteString
b ->
  let !r :: Word64
r = Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Word64
X.w64BE ByteString
b)
  in (# Word64 -> Res e Word64
forall a e. a -> Res e a
Yes Word64
r #)

f64LE :: ByteString -> (# Res e Double #)
f64LE :: forall e. ByteString -> (# Res e Double #)
f64LE = \ByteString
b ->
  let !r :: Double
r = Word64 -> Double
castWord64ToDouble (ByteString -> Word64
X.w64LE ByteString
b)
  in (# Double -> Res e Double
forall a e. a -> Res e a
Yes Double
r #)

f64BE :: ByteString -> (# Res e Double #)
f64BE :: forall e. ByteString -> (# Res e Double #)
f64BE = \ByteString
b ->
  let !r :: Double
r = Word64 -> Double
castWord64ToDouble (ByteString -> Word64
X.w64BE ByteString
b)
  in (# Double -> Res e Double
forall a e. a -> Res e a
Yes Double
r #)