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