module Haskus.Format.Binary.Bits
(
module Haskus.Format.Binary.Bits.Basic
, BitReversable (..)
, reverseBitsGeneric
, reverseLeastBits
, makeMask
, maskLeastBits
, bitsToString
, bitsFromString
, getBitRange
, bitOffset
, byteOffset
)
where
import Haskus.Utils.List (foldl')
import Haskus.Format.Binary.Bits.Basic
import Haskus.Format.Binary.Bits.Reverse
import Haskus.Format.Binary.Bits.Order
import Haskus.Format.Binary.Word
makeMask :: (FiniteBits a) => Word -> a
makeMask n = x' `shiftR` (finiteBitSize x fromIntegral n)
where
x = complement zeroBits
x' = if isSigned x
then error "Cannot use makeMask with a signed type"
else x
maskLeastBits :: (FiniteBits a) => Word -> a -> a
maskLeastBits n v = v .&. makeMask n
bitOffset :: Word -> Word
bitOffset n = makeMask 3 .&. n
byteOffset :: Word -> Word
byteOffset n = n `shiftR` 3
reverseLeastBits :: (FiniteBits a, BitReversable a) => Word -> a -> a
reverseLeastBits n value = reverseBits value `shiftR` (finiteBitSize value fromIntegral n)
bitsToString :: FiniteBits a => a -> String
bitsToString x = fmap b [s, s1 .. 0]
where
s = finiteBitSize x 1
b v = if testBit x v then '1' else '0'
bitsFromString :: Bits a => String -> a
bitsFromString xs = foldl' b zeroBits (reverse xs `zip` [0..])
where
b x ('0',i) = clearBit x i
b x ('1',i) = setBit x i
b _ (c,_) = error $ "Invalid character in the string: " ++ [c]
getBitRange :: (BitReversable b, FiniteBits b) => BitOrder -> Word -> Word -> b -> b
getBitRange bo o n c = case bo of
BB -> maskLeastBits n $ c `shiftR` d
BL -> maskLeastBits n $ reverseBits c `shiftR` o'
LB -> maskLeastBits n $ reverseBits c `shiftR` d
LL -> maskLeastBits n $ c `shiftR` o'
where
o' = fromIntegral o
d = finiteBitSize c fromIntegral n fromIntegral o