module Rattletrap.BitPut where

import qualified Data.Bits as Bits
import qualified Data.ByteString as ByteString
import qualified Rattletrap.BitBuilder as BitBuilder
import qualified Rattletrap.BytePut as BytePut

newtype BitPut = BitPut (BitBuilder.BitBuilder -> BitBuilder.BitBuilder)

instance Semigroup BitPut where
  BitPut
f1 <> :: BitPut -> BitPut -> BitPut
<> BitPut
f2 = (BitBuilder -> BitBuilder) -> BitPut
BitPut ((BitBuilder -> BitBuilder) -> BitPut)
-> (BitBuilder -> BitBuilder) -> BitPut
forall a b. (a -> b) -> a -> b
$ BitPut -> BitBuilder -> BitBuilder
run BitPut
f2 (BitBuilder -> BitBuilder)
-> (BitBuilder -> BitBuilder) -> BitBuilder -> BitBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitPut -> BitBuilder -> BitBuilder
run BitPut
f1

instance Monoid BitPut where
  mempty :: BitPut
mempty = (BitBuilder -> BitBuilder) -> BitPut
BitPut BitBuilder -> BitBuilder
forall a. a -> a
id

run :: BitPut -> BitBuilder.BitBuilder -> BitBuilder.BitBuilder
run :: BitPut -> BitBuilder -> BitBuilder
run (BitPut BitBuilder -> BitBuilder
f) = BitBuilder -> BitBuilder
f

toBytePut :: BitPut -> BytePut.BytePut
toBytePut :: BitPut -> BytePut
toBytePut BitPut
b = BitBuilder -> BytePut
BitBuilder.toBuilder (BitBuilder -> BytePut) -> BitBuilder -> BytePut
forall a b. (a -> b) -> a -> b
$ BitPut -> BitBuilder -> BitBuilder
run BitPut
b BitBuilder
BitBuilder.empty

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
. 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 = (BitBuilder -> BitBuilder) -> BitPut
BitPut ((BitBuilder -> BitBuilder) -> BitPut)
-> (Bool -> BitBuilder -> BitBuilder) -> Bool -> BitPut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> BitBuilder -> BitBuilder
BitBuilder.push

byteString :: ByteString.ByteString -> BitPut
byteString :: ByteString -> BitPut
byteString = (Word8 -> BitPut) -> [Word8] -> BitPut
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Int -> Word8 -> BitPut
forall a. Bits a => Int -> a -> BitPut
bits Int
8) ([Word8] -> BitPut)
-> (ByteString -> [Word8]) -> ByteString -> BitPut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
ByteString.unpack