{- |
Module      : Data.ASN1.BitArray
License     : BSD-style
Copyright   : (c) 2010-2013 Vincent Hanquez <vincent@snarc.org>
Stability   : experimental
Portability : unknown
-}

module Data.ASN1.BitArray
  ( BitArray (..)
  , BitArrayOutOfBound (..)
  , bitArrayLength
  , bitArrayGetBit
  , bitArraySetBitValue
  , bitArraySetBit
  , bitArrayClearBit
  , bitArrayGetData
  , toBitArray
  ) where

import           Control.Exception ( Exception, throw )
import           Data.Bits ( clearBit, setBit, testBit )
import           Data.ByteString ( ByteString )
import qualified Data.ByteString as B
import           Data.Maybe ( fromJust )
import           Data.Word ( Word64 )

-- | Thrown in case of out of bounds in the bitarray.

newtype BitArrayOutOfBound = BitArrayOutOfBound Word64
  deriving (BitArrayOutOfBound -> BitArrayOutOfBound -> Bool
(BitArrayOutOfBound -> BitArrayOutOfBound -> Bool)
-> (BitArrayOutOfBound -> BitArrayOutOfBound -> Bool)
-> Eq BitArrayOutOfBound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BitArrayOutOfBound -> BitArrayOutOfBound -> Bool
== :: BitArrayOutOfBound -> BitArrayOutOfBound -> Bool
$c/= :: BitArrayOutOfBound -> BitArrayOutOfBound -> Bool
/= :: BitArrayOutOfBound -> BitArrayOutOfBound -> Bool
Eq, Int -> BitArrayOutOfBound -> ShowS
[BitArrayOutOfBound] -> ShowS
BitArrayOutOfBound -> String
(Int -> BitArrayOutOfBound -> ShowS)
-> (BitArrayOutOfBound -> String)
-> ([BitArrayOutOfBound] -> ShowS)
-> Show BitArrayOutOfBound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BitArrayOutOfBound -> ShowS
showsPrec :: Int -> BitArrayOutOfBound -> ShowS
$cshow :: BitArrayOutOfBound -> String
show :: BitArrayOutOfBound -> String
$cshowList :: [BitArrayOutOfBound] -> ShowS
showList :: [BitArrayOutOfBound] -> ShowS
Show)

instance Exception BitArrayOutOfBound

-- | Represent a bitarray / bitmap.

--

-- The memory representation starts at bit 0.

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

-- | Returns the length of bits in this bitarray.

bitArrayLength :: BitArray -> Word64
bitArrayLength :: BitArray -> Word64
bitArrayLength (BitArray Word64
l ByteString
_) = Word64
l

bitArrayOutOfBound :: Word64 -> a
bitArrayOutOfBound :: forall a. Word64 -> a
bitArrayOutOfBound Word64
n = BitArrayOutOfBound -> a
forall a e. Exception e => e -> a
throw (BitArrayOutOfBound -> a) -> BitArrayOutOfBound -> a
forall a b. (a -> b) -> a -> b
$ Word64 -> BitArrayOutOfBound
BitArrayOutOfBound Word64
n

-- | Get the nth bits.

bitArrayGetBit :: BitArray -> Word64 -> Bool
bitArrayGetBit :: BitArray -> Word64 -> Bool
bitArrayGetBit (BitArray Word64
l ByteString
d) Word64
n
  | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
l    = Word64 -> Bool
forall a. Word64 -> a
bitArrayOutOfBound Word64
n
  | Bool
otherwise =
      (Word8 -> Int -> Bool) -> Int -> Word8 -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (Int
7Int -> Int -> Int
forall a. Num a => a -> a -> a
-Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
bitn) (Word8 -> Bool) -> Word8 -> Bool
forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
B.index ByteString
d (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
offset)
 where
  (Word64
offset, Word64
bitn) = Word64
n Word64 -> Word64 -> (Word64, Word64)
forall a. Integral a => a -> a -> (a, a)
`divMod` Word64
8

-- | Set the nth bit to the value specified.

bitArraySetBitValue :: BitArray -> Word64 -> Bool -> BitArray
bitArraySetBitValue :: BitArray -> Word64 -> Bool -> BitArray
bitArraySetBitValue (BitArray Word64
l ByteString
d) Word64
n Bool
v
  | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
l    = Word64 -> BitArray
forall a. Word64 -> a
bitArrayOutOfBound Word64
n
  | Bool
otherwise =
      let (ByteString
before, ByteString
after) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
offset) ByteString
d
      in
          -- array bound check before prevent fromJust from failing.

          let (Word8
w, ByteString
remaining) = Maybe (Word8, ByteString) -> (Word8, ByteString)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Word8, ByteString) -> (Word8, ByteString))
-> Maybe (Word8, ByteString) -> (Word8, ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
after
              remaining' :: ByteString
remaining' = Word8 -> Int -> Word8
setter Word8
w (Int
7Int -> Int -> Int
forall a. Num a => a -> a -> a
-Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
bitn) Word8 -> ByteString -> ByteString
`B.cons` ByteString
remaining
          in  Word64 -> ByteString -> BitArray
BitArray Word64
l (ByteString
before ByteString -> ByteString -> ByteString
`B.append` ByteString
remaining')
 where
  (Word64
offset, Word64
bitn) = Word64
n Word64 -> Word64 -> (Word64, Word64)
forall a. Integral a => a -> a -> (a, a)
`divMod` Word64
8
  setter :: Word8 -> Int -> Word8
setter = if Bool
v then Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
setBit else Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
clearBit

-- | Set the nth bit.

bitArraySetBit :: BitArray -> Word64 -> BitArray
bitArraySetBit :: BitArray -> Word64 -> BitArray
bitArraySetBit BitArray
bitarray Word64
n = BitArray -> Word64 -> Bool -> BitArray
bitArraySetBitValue BitArray
bitarray Word64
n Bool
True

-- | Clear the nth bit.

bitArrayClearBit :: BitArray -> Word64 -> BitArray
bitArrayClearBit :: BitArray -> Word64 -> BitArray
bitArrayClearBit BitArray
bitarray Word64
n = BitArray -> Word64 -> Bool -> BitArray
bitArraySetBitValue BitArray
bitarray Word64
n Bool
False

-- | Get padded bytestring from the bitarray.

bitArrayGetData :: BitArray -> ByteString
bitArrayGetData :: BitArray -> ByteString
bitArrayGetData (BitArray Word64
_ ByteString
d) = ByteString
d

-- | Number of bits to skip at the end (padding).

toBitArray :: ByteString -> Int -> BitArray
toBitArray :: ByteString -> Int -> BitArray
toBitArray ByteString
l Int
toSkip =
  Word64 -> ByteString -> BitArray
BitArray (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
l Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
toSkip)) ByteString
l