module Rattletrap.ByteGet where

import qualified Data.Bits as Bits
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Lazy as LazyByteString
import qualified Data.Functor.Identity as Identity
import qualified Data.Int as Int
import qualified Data.Word as Word
import qualified GHC.Float as Float
import qualified Rattletrap.Get as Get

type ByteGet = Get.Get ByteString.ByteString Identity.Identity

run :: ByteGet a -> ByteString.ByteString -> Either String a
run :: ByteGet a -> ByteString -> Either String a
run ByteGet a
g = ((ByteString, a) -> a)
-> Either String (ByteString, a) -> Either String a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString, a) -> a
forall a b. (a, b) -> b
snd (Either String (ByteString, a) -> Either String a)
-> (ByteString -> Either String (ByteString, a))
-> ByteString
-> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (Either String (ByteString, a))
-> Either String (ByteString, a)
forall a. Identity a -> a
Identity.runIdentity (Identity (Either String (ByteString, a))
 -> Either String (ByteString, a))
-> (ByteString -> Identity (Either String (ByteString, a)))
-> ByteString
-> Either String (ByteString, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteGet a -> ByteString -> Identity (Either String (ByteString, a))
forall s (m :: * -> *) a.
Get s m a -> s -> m (Either String (s, a))
Get.run ByteGet a
g

byteString :: Int -> ByteGet ByteString.ByteString
byteString :: Int -> ByteGet ByteString
byteString Int
n = do
  ByteString
s1 <- ByteGet ByteString
forall (m :: * -> *) s. Applicative m => Get s m s
Get.get
  let (ByteString
x, ByteString
s2) = Int -> ByteString -> (ByteString, ByteString)
ByteString.splitAt Int
n ByteString
s1
  ByteString -> Get ByteString Identity ()
forall (m :: * -> *) s. Applicative m => s -> Get s m ()
Get.put ByteString
s2
  ByteString -> ByteGet ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
x

float :: ByteGet Float
float :: ByteGet Float
float = Word32 -> Float
Float.castWord32ToFloat (Word32 -> Float)
-> Get ByteString Identity Word32 -> ByteGet Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString Identity Word32
word32

int8 :: ByteGet Int.Int8
int8 :: ByteGet Int8
int8 = Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int8) -> Get ByteString Identity Word8 -> ByteGet Int8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString Identity Word8
word8

int32 :: ByteGet Int.Int32
int32 :: ByteGet Int32
int32 = Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int32)
-> Get ByteString Identity Word32 -> ByteGet Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString Identity Word32
word32

int64 :: ByteGet Int.Int64
int64 :: ByteGet Int64
int64 = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64)
-> Get ByteString Identity Word64 -> ByteGet Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString Identity Word64
word64

remaining :: ByteGet LazyByteString.ByteString
remaining :: ByteGet ByteString
remaining = do
  ByteString
x <- ByteGet ByteString
forall (m :: * -> *) s. Applicative m => Get s m s
Get.get
  ByteString -> Get ByteString Identity ()
forall (m :: * -> *) s. Applicative m => s -> Get s m ()
Get.put ByteString
ByteString.empty
  ByteString -> ByteGet ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> ByteGet ByteString)
-> ByteString -> ByteGet ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LazyByteString.fromStrict ByteString
x

word8 :: ByteGet Word.Word8
word8 :: Get ByteString Identity Word8
word8 = ByteString -> Word8
ByteString.head (ByteString -> Word8)
-> ByteGet ByteString -> Get ByteString Identity Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ByteGet ByteString
byteString Int
1

word32 :: ByteGet Word.Word32
word32 :: Get ByteString Identity Word32
word32 = do
  ByteString
x <- Int -> ByteGet ByteString
byteString Int
4
  Word32 -> Get ByteString Identity Word32
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Word32 -> Get ByteString Identity Word32)
-> Word32 -> Get ByteString Identity Word32
forall a b. (a -> b) -> a -> b
$ Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
Bits.shiftL (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> Word8 -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> Word8
ByteString.index ByteString
x Int
0) Int
0
    Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
Bits.shiftL (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> Word8 -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> Word8
ByteString.index ByteString
x Int
1) Int
8
    Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
Bits.shiftL (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> Word8 -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> Word8
ByteString.index ByteString
x Int
2) Int
16
    Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
Bits.shiftL (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word32) -> Word8 -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> Word8
ByteString.index ByteString
x Int
3) Int
24

word64 :: ByteGet Word.Word64
word64 :: Get ByteString Identity Word64
word64 = do
  ByteString
x <- Int -> ByteGet ByteString
byteString Int
8
  Word64 -> Get ByteString Identity Word64
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Word64 -> Get ByteString Identity Word64)
-> Word64 -> Get ByteString Identity Word64
forall a b. (a -> b) -> a -> b
$ Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
Bits.shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> Word8 -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> Word8
ByteString.index ByteString
x Int
0) Int
0
    Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
Bits.shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> Word8 -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> Word8
ByteString.index ByteString
x Int
1) Int
8
    Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
Bits.shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> Word8 -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> Word8
ByteString.index ByteString
x Int
2) Int
16
    Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
Bits.shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> Word8 -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> Word8
ByteString.index ByteString
x Int
3) Int
24
    Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
Bits.shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> Word8 -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> Word8
ByteString.index ByteString
x Int
4) Int
32
    Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
Bits.shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> Word8 -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> Word8
ByteString.index ByteString
x Int
5) Int
40
    Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
Bits.shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> Word8 -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> Word8
ByteString.index ByteString
x Int
6) Int
48
    Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
Bits.shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word64) -> Word8 -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> Word8
ByteString.index ByteString
x Int
7) Int
56