1-- | 2-- Module : Data.ASN1.BitArray 3-- License : BSD-style 4-- Maintainer : Vincent Hanquez <vincent@snarc.org> 5-- Stability : experimental 6-- Portability : unknown 7-- 8{-# LANGUAGE DeriveDataTypeable #-} 9module Data.ASN1.BitArray 10 ( BitArray(..) 11 , BitArrayOutOfBound(..) 12 , bitArrayLength 13 , bitArrayGetBit 14 , bitArraySetBitValue 15 , bitArraySetBit 16 , bitArrayClearBit 17 , bitArrayGetData 18 , toBitArray 19 ) where 20 21import Data.Bits 22import Data.Word 23import Data.Maybe 24import Data.ByteString (ByteString) 25import qualified Data.ByteString as B 26import Data.Typeable 27import Control.Exception (Exception, throw) 28 29-- | throwed in case of out of bounds in the bitarray. 30data BitArrayOutOfBound = BitArrayOutOfBound Word64 31 deriving (Show,Eq,Typeable) 32instance Exception BitArrayOutOfBound 33 34-- | represent a bitarray / bitmap 35-- 36-- the memory representation start at bit 0 37data BitArray = BitArray Word64 ByteString 38 deriving (Show,Eq) 39 40-- | returns the length of bits in this bitarray 41bitArrayLength :: BitArray -> Word64 42bitArrayLength (BitArray l _) = l 43 44bitArrayOutOfBound :: Word64 -> a 45bitArrayOutOfBound n = throw $ BitArrayOutOfBound n 46 47-- | get the nth bits 48bitArrayGetBit :: BitArray -> Word64 -> Bool 49bitArrayGetBit (BitArray l d) n 50 | n >= l = bitArrayOutOfBound n 51 | otherwise = flip testBit (7-fromIntegral bitn) $ B.index d (fromIntegral offset) 52 where (offset, bitn) = n `divMod` 8 53 54-- | set the nth bit to the value specified 55bitArraySetBitValue :: BitArray -> Word64 -> Bool -> BitArray 56bitArraySetBitValue (BitArray l d) n v 57 | n >= l = bitArrayOutOfBound n 58 | otherwise = 59 let (before,after) = B.splitAt (fromIntegral offset) d in 60 -- array bound check before prevent fromJust from failing. 61 let (w,remaining) = fromJust $ B.uncons after in 62 BitArray l (before `B.append` (setter w (7-fromIntegral bitn) `B.cons` remaining)) 63 where 64 (offset, bitn) = n `divMod` 8 65 setter = if v then setBit else clearBit 66 67-- | set the nth bits 68bitArraySetBit :: BitArray -> Word64 -> BitArray 69bitArraySetBit bitarray n = bitArraySetBitValue bitarray n True 70 71-- | clear the nth bits 72bitArrayClearBit :: BitArray -> Word64 -> BitArray 73bitArrayClearBit bitarray n = bitArraySetBitValue bitarray n False 74 75-- | get padded bytestring of the bitarray 76bitArrayGetData :: BitArray -> ByteString 77bitArrayGetData (BitArray _ d) = d 78 79-- | number of bit to skip at the end (padding) 80toBitArray :: ByteString -> Int -> BitArray 81toBitArray l toSkip = 82 BitArray (fromIntegral (B.length l * 8 - fromIntegral toSkip)) l 83