module Rattletrap.Decode.Common
  ( Decode
  , DecodeBits
  , decodeWhen
  , getBitsLE
  , getByteStringBits
  , getWord8Bits
  , runDecode
  , runDecodeBits
  , toBits
  , Binary.getFloatle
  , Binary.getByteString
  , Binary.getInt8
  , Binary.getInt32le
  , Binary.getInt64le
  , Binary.getWord8
  , Binary.getWord32le
  , Binary.getWord64le
  , BinaryBits.getBool
  )
where

import qualified Control.Applicative as Applicative
import qualified Control.Monad as Monad
import qualified Data.Binary as Binary
import qualified Data.Binary.Bits.Get as BinaryBits
import qualified Data.Binary.Get as Binary
import qualified Data.Bits as Bits
import qualified Data.ByteString as Bytes
import qualified Data.ByteString.Lazy as LazyBytes
import qualified Data.Word as Word
import qualified Rattletrap.Utility.Bytes as Utility

type Decode = Binary.Get

type DecodeBits = BinaryBits.BitGet

decodeWhen
  :: (Applicative m, Applicative.Alternative f) => Bool -> m a -> m (f a)
decodeWhen :: Bool -> m a -> m (f a)
decodeWhen Bool
p m a
f = if Bool
p then (a -> f a) -> m a -> m (f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure m a
f else f a -> m (f a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure f a
forall (f :: * -> *) a. Alternative f => f a
Applicative.empty

getByteStringBits :: Int -> DecodeBits Bytes.ByteString
getByteStringBits :: Int -> DecodeBits ByteString
getByteStringBits = Int -> DecodeBits ByteString
BinaryBits.getByteString

getWord8Bits :: Int -> DecodeBits Word.Word8
getWord8Bits :: Int -> DecodeBits Word8
getWord8Bits = Int -> DecodeBits Word8
BinaryBits.getWord8

runDecode :: Decode a -> Bytes.ByteString -> Either String a
runDecode :: Decode a -> ByteString -> Either String a
runDecode Decode a
decode ByteString
bytes =
  case Decode a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
Binary.runGetOrFail Decode a
decode (ByteString -> ByteString
LazyBytes.fromStrict ByteString
bytes) of
    Left (ByteString
_, ByteOffset
_, String
x) -> String -> Either String a
forall a b. a -> Either a b
Left String
x
    Right (ByteString
_, ByteOffset
_, a
x) -> a -> Either String a
forall a b. b -> Either a b
Right a
x

runDecodeBits :: DecodeBits a -> Bytes.ByteString -> Either String a
runDecodeBits :: DecodeBits a -> ByteString -> Either String a
runDecodeBits = Decode a -> ByteString -> Either String a
forall a. Decode a -> ByteString -> Either String a
runDecode (Decode a -> ByteString -> Either String a)
-> (DecodeBits a -> Decode a)
-> DecodeBits a
-> ByteString
-> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeBits a -> Decode a
forall a. BitGet a -> Get a
BinaryBits.runBitGet

toBits :: Decode a -> Int -> DecodeBits a
toBits :: Decode a -> Int -> DecodeBits a
toBits Decode a
decode Int
size = do
  ByteString
bytes <- Int -> DecodeBits ByteString
BinaryBits.getByteString Int
size
  case Decode a -> ByteString -> Either String a
forall a. Decode a -> ByteString -> Either String a
runDecode Decode a
decode (ByteString -> ByteString
Utility.reverseBytes ByteString
bytes) of
    Left String
problem -> String -> DecodeBits a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
problem
    Right a
result -> a -> DecodeBits a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result

getBitsLE :: Bits.Bits a => Int -> BinaryBits.BitGet a
getBitsLE :: Int -> BitGet a
getBitsLE Int
size = do
  [Bool]
bits <- Int -> BitGet Bool -> BitGet [Bool]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
Monad.replicateM Int
size BitGet Bool
BinaryBits.getBool
  a -> BitGet a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> BitGet a) -> a -> BitGet a
forall a b. (a -> b) -> a -> b
$ (Bool -> a -> a) -> a -> [Bool] -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
    (\Bool
bit a
x -> let y :: a
y = a -> Int -> a
forall a. Bits a => a -> Int -> a
Bits.shiftL a
x Int
1 in if Bool
bit then a -> Int -> a
forall a. Bits a => a -> Int -> a
Bits.setBit a
y Int
0 else a
y)
    a
forall a. Bits a => a
Bits.zeroBits
    [Bool]
bits