module Rattletrap.BitString where

import qualified Data.Bits as Bits
import qualified Data.ByteString as ByteString

data BitString = BitString
  { BitString -> ByteString
byteString :: ByteString.ByteString,
    BitString -> Int
offset :: Int
  }
  deriving (BitString -> BitString -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BitString -> BitString -> Bool
$c/= :: BitString -> BitString -> Bool
== :: BitString -> BitString -> Bool
$c== :: BitString -> BitString -> Bool
Eq, Int -> BitString -> ShowS
[BitString] -> ShowS
BitString -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BitString] -> ShowS
$cshowList :: [BitString] -> ShowS
show :: BitString -> String
$cshow :: BitString -> String
showsPrec :: Int -> BitString -> ShowS
$cshowsPrec :: Int -> BitString -> ShowS
Show)

fromByteString :: ByteString.ByteString -> BitString
fromByteString :: ByteString -> BitString
fromByteString ByteString
byteString = BitString {ByteString
byteString :: ByteString
byteString :: ByteString
byteString, offset :: Int
offset = Int
0}

pop :: BitString -> Maybe (Bool, BitString)
pop :: BitString -> Maybe (Bool, BitString)
pop BitString
old = do
  (Word8
word, ByteString
byteString) <- ByteString -> Maybe (Word8, ByteString)
ByteString.uncons forall a b. (a -> b) -> a -> b
$ BitString -> ByteString
byteString BitString
old
  let bit :: Bool
bit = forall a. Bits a => a -> Int -> Bool
Bits.testBit Word8
word forall a b. (a -> b) -> a -> b
$ BitString -> Int
offset BitString
old
      new :: BitString
new =
        if BitString -> Int
offset BitString
old forall a. Eq a => a -> a -> Bool
== Int
7
          then ByteString -> BitString
fromByteString ByteString
byteString
          else BitString
old {offset :: Int
offset = BitString -> Int
offset BitString
old forall a. Num a => a -> a -> a
+ Int
1}
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool
bit, BitString
new)