module Rattletrap.BitPut where

import qualified Data.Binary.Bits.Put as BinaryBits
import qualified Data.Binary.Put as Binary
import qualified Data.Bits as Bits
import qualified Data.ByteString as ByteString
import qualified Data.Word as Word
import qualified Rattletrap.BytePut as BytePut
import qualified Rattletrap.Utility.Bytes as Utility

newtype BitPut = BitPut (BinaryBits.BitPut ())

instance Semigroup BitPut where
  BitPut
x <> :: BitPut -> BitPut -> BitPut
<> BitPut
y = BitPut () -> BitPut
fromBinaryBits (BitPut () -> BitPut) -> BitPut () -> BitPut
forall a b. (a -> b) -> a -> b
$ BitPut -> BitPut ()
toBinaryBits BitPut
x BitPut () -> BitPut () -> BitPut ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BitPut -> BitPut ()
toBinaryBits BitPut
y

instance Monoid BitPut where
  mempty :: BitPut
mempty = BitPut () -> BitPut
fromBinaryBits (BitPut () -> BitPut) -> BitPut () -> BitPut
forall a b. (a -> b) -> a -> b
$ () -> BitPut ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

fromBinaryBits :: BinaryBits.BitPut () -> BitPut
fromBinaryBits :: BitPut () -> BitPut
fromBinaryBits = BitPut () -> BitPut
BitPut

toBinaryBits :: BitPut -> BinaryBits.BitPut ()
toBinaryBits :: BitPut -> BitPut ()
toBinaryBits (BitPut BitPut ()
x) = BitPut ()
x

toBytePut :: BitPut -> BytePut.BytePut
toBytePut :: BitPut -> BytePut
toBytePut = PutM () -> BytePut
forall a. PutM a -> BytePut
Binary.execPut (PutM () -> BytePut) -> (BitPut -> PutM ()) -> BitPut -> BytePut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitPut () -> PutM ()
BinaryBits.runBitPut (BitPut () -> PutM ())
-> (BitPut -> BitPut ()) -> BitPut -> PutM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitPut -> BitPut ()
toBinaryBits

fromBytePut :: BytePut.BytePut -> BitPut
fromBytePut :: BytePut -> BitPut
fromBytePut = ByteString -> BitPut
byteString (ByteString -> BitPut)
-> (BytePut -> ByteString) -> BytePut -> BitPut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Utility.reverseBytes (ByteString -> ByteString)
-> (BytePut -> ByteString) -> BytePut -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BytePut -> ByteString
BytePut.toByteString

bits :: Bits.Bits a => Int -> a -> BitPut
bits :: Int -> a -> BitPut
bits Int
n a
x = (Int -> BitPut) -> [Int] -> BitPut
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Bool -> BitPut
bool (Bool -> BitPut) -> (Int -> Bool) -> Int -> BitPut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
Bits.testBit a
x) [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

bool :: Bool -> BitPut
bool :: Bool -> BitPut
bool = BitPut () -> BitPut
fromBinaryBits (BitPut () -> BitPut) -> (Bool -> BitPut ()) -> Bool -> BitPut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> BitPut ()
BinaryBits.putBool

byteString :: ByteString.ByteString -> BitPut
byteString :: ByteString -> BitPut
byteString = BitPut () -> BitPut
fromBinaryBits (BitPut () -> BitPut)
-> (ByteString -> BitPut ()) -> ByteString -> BitPut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BitPut ()
BinaryBits.putByteString

word8 :: Int -> Word.Word8 -> BitPut
word8 :: Int -> Word8 -> BitPut
word8 Int
n = BitPut () -> BitPut
fromBinaryBits (BitPut () -> BitPut) -> (Word8 -> BitPut ()) -> Word8 -> BitPut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8 -> BitPut ()
BinaryBits.putWord8 Int
n