{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module HaskellWorks.Data.Bits.BitLength
    ( -- * Bit map
      BitLength(..)
    , elemBitLength
    , elemBitEnd
    ) where

import Data.Word
import HaskellWorks.Data.AtIndex
import HaskellWorks.Data.Naive
import HaskellWorks.Data.Positioning
import Prelude                       hiding (length)

import qualified Data.Bit             as Bit
import qualified Data.Bit.ThreadSafe  as BitTS
import qualified Data.Vector          as DV
import qualified Data.Vector.Storable as DVS
import qualified Data.Vector.Unboxed  as DVU

class BitLength v where
  -- | Number of bits in a value including ones and zeros.
  bitLength :: v -> Count

  -- | Number of bits in a value including ones and zeros as a position.
  endPosition :: v -> Position
  endPosition = Count -> Position
forall a. ToPosition a => a -> Position
toPosition (Count -> Position) -> (v -> Count) -> v -> Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Count
forall v. BitLength v => v -> Count
bitLength
  {-# INLINE endPosition #-}

--------------------------------------------------------------------------------
-- Functions

elemBitLength :: (AtIndex v, BitLength (Elem v)) => v -> Count
elemBitLength :: v -> Count
elemBitLength v
v = Elem v -> Count
forall v. BitLength v => v -> Count
bitLength (v
v v -> Position -> Elem v
forall v. AtIndex v => v -> Position -> Elem v
!!! Position
0)
{-# INLINE elemBitLength #-}

elemBitEnd :: (AtIndex v, BitLength (Elem v)) => v -> Position
elemBitEnd :: v -> Position
elemBitEnd v
v = Elem v -> Position
forall v. BitLength v => v -> Position
endPosition (v
v v -> Position -> Elem v
forall v. AtIndex v => v -> Position -> Elem v
!!! Position
0)
{-# INLINE elemBitEnd #-}

--------------------------------------------------------------------------------
-- Instances

instance BitLength Bool where
  bitLength :: Bool -> Count
bitLength Bool
_ = Count
1
  {-# INLINE bitLength #-}

instance BitLength [Bool] where
  bitLength :: [Bool] -> Count
bitLength = Count -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Count -> Count) -> ([Bool] -> Count) -> [Bool] -> Count
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> Count
forall v. Length v => v -> Count
length
  {-# INLINE bitLength #-}

instance BitLength Word8 where
  bitLength :: Word8 -> Count
bitLength Word8
_ = Count
8
  {-# INLINE bitLength #-}

instance BitLength Word16 where
  bitLength :: Word16 -> Count
bitLength Word16
_ = Count
16
  {-# INLINE bitLength #-}

instance BitLength Word32 where
  bitLength :: Word32 -> Count
bitLength Word32
_ = Count
32
  {-# INLINE bitLength #-}

instance BitLength Word64 where
  bitLength :: Count -> Count
bitLength Count
_ = Count
64
  {-# INLINE bitLength #-}

instance BitLength (Naive Word8) where
  bitLength :: Naive Word8 -> Count
bitLength Naive Word8
_ = Count
8
  {-# INLINE bitLength #-}

instance BitLength (Naive Word16) where
  bitLength :: Naive Word16 -> Count
bitLength Naive Word16
_ = Count
16
  {-# INLINE bitLength #-}

instance BitLength (Naive Word32) where
  bitLength :: Naive Word32 -> Count
bitLength Naive Word32
_ = Count
32
  {-# INLINE bitLength #-}

instance BitLength (Naive Word64) where
  bitLength :: Naive Count -> Count
bitLength Naive Count
_ = Count
64
  {-# INLINE bitLength #-}

instance BitLength [Word8] where
  bitLength :: [Word8] -> Count
bitLength [Word8]
v = Count -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Word8] -> Count
forall v. Length v => v -> Count
length [Word8]
v) Count -> Count -> Count
forall a. Num a => a -> a -> a
* Word8 -> Count
forall v. BitLength v => v -> Count
bitLength ([Word8] -> Word8
forall a. [a] -> a
head [Word8]
v)
  {-# INLINE bitLength #-}

instance BitLength [Word16] where
  bitLength :: [Word16] -> Count
bitLength [Word16]
v = Count -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Word16] -> Count
forall v. Length v => v -> Count
length [Word16]
v) Count -> Count -> Count
forall a. Num a => a -> a -> a
* Word16 -> Count
forall v. BitLength v => v -> Count
bitLength ([Word16] -> Word16
forall a. [a] -> a
head [Word16]
v)
  {-# INLINE bitLength #-}

instance BitLength [Word32] where
  bitLength :: [Word32] -> Count
bitLength [Word32]
v = Count -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Word32] -> Count
forall v. Length v => v -> Count
length [Word32]
v) Count -> Count -> Count
forall a. Num a => a -> a -> a
* Word32 -> Count
forall v. BitLength v => v -> Count
bitLength ([Word32] -> Word32
forall a. [a] -> a
head [Word32]
v)
  {-# INLINE bitLength #-}

instance BitLength [Word64] where
  bitLength :: [Count] -> Count
bitLength [Count]
v = Count -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Count] -> Count
forall v. Length v => v -> Count
length [Count]
v) Count -> Count -> Count
forall a. Num a => a -> a -> a
* Count -> Count
forall v. BitLength v => v -> Count
bitLength ([Count] -> Count
forall a. [a] -> a
head [Count]
v)
  {-# INLINE bitLength #-}

instance BitLength (DV.Vector Word8) where
  bitLength :: Vector Word8 -> Count
bitLength Vector Word8
v = Vector Word8 -> Count
forall v. Length v => v -> Count
length Vector Word8
v Count -> Count -> Count
forall a. Num a => a -> a -> a
* Word8 -> Count
forall v. BitLength v => v -> Count
bitLength (Vector Word8
v Vector Word8 -> Position -> Elem (Vector Word8)
forall v. AtIndex v => v -> Position -> Elem v
!!! Position
0)
  {-# INLINE bitLength #-}

instance BitLength (DV.Vector Word16) where
  bitLength :: Vector Word16 -> Count
bitLength Vector Word16
v = Vector Word16 -> Count
forall v. Length v => v -> Count
length Vector Word16
v Count -> Count -> Count
forall a. Num a => a -> a -> a
* Word16 -> Count
forall v. BitLength v => v -> Count
bitLength (Vector Word16
v Vector Word16 -> Position -> Elem (Vector Word16)
forall v. AtIndex v => v -> Position -> Elem v
!!! Position
0)
  {-# INLINE bitLength #-}

instance BitLength (DV.Vector Word32) where
  bitLength :: Vector Word32 -> Count
bitLength Vector Word32
v = Vector Word32 -> Count
forall v. Length v => v -> Count
length Vector Word32
v Count -> Count -> Count
forall a. Num a => a -> a -> a
* Word32 -> Count
forall v. BitLength v => v -> Count
bitLength (Vector Word32
v Vector Word32 -> Position -> Elem (Vector Word32)
forall v. AtIndex v => v -> Position -> Elem v
!!! Position
0)
  {-# INLINE bitLength #-}

instance BitLength (DV.Vector Word64) where
  bitLength :: Vector Count -> Count
bitLength Vector Count
v = Vector Count -> Count
forall v. Length v => v -> Count
length Vector Count
v Count -> Count -> Count
forall a. Num a => a -> a -> a
* Count -> Count
forall v. BitLength v => v -> Count
bitLength (Vector Count
v Vector Count -> Position -> Elem (Vector Count)
forall v. AtIndex v => v -> Position -> Elem v
!!! Position
0)
  {-# INLINE bitLength #-}

instance BitLength (DVS.Vector Word8) where
  bitLength :: Vector Word8 -> Count
bitLength Vector Word8
v = Vector Word8 -> Count
forall v. Length v => v -> Count
length Vector Word8
v Count -> Count -> Count
forall a. Num a => a -> a -> a
* Word8 -> Count
forall v. BitLength v => v -> Count
bitLength (Vector Word8
v Vector Word8 -> Position -> Elem (Vector Word8)
forall v. AtIndex v => v -> Position -> Elem v
!!! Position
0)
  {-# INLINE bitLength #-}

instance BitLength (DVS.Vector Word16) where
  bitLength :: Vector Word16 -> Count
bitLength Vector Word16
v = Vector Word16 -> Count
forall v. Length v => v -> Count
length Vector Word16
v Count -> Count -> Count
forall a. Num a => a -> a -> a
* Word16 -> Count
forall v. BitLength v => v -> Count
bitLength (Vector Word16
v Vector Word16 -> Position -> Elem (Vector Word16)
forall v. AtIndex v => v -> Position -> Elem v
!!! Position
0)
  {-# INLINE bitLength #-}

instance BitLength (DVS.Vector Word32) where
  bitLength :: Vector Word32 -> Count
bitLength Vector Word32
v = Vector Word32 -> Count
forall v. Length v => v -> Count
length Vector Word32
v Count -> Count -> Count
forall a. Num a => a -> a -> a
* Word32 -> Count
forall v. BitLength v => v -> Count
bitLength (Vector Word32
v Vector Word32 -> Position -> Elem (Vector Word32)
forall v. AtIndex v => v -> Position -> Elem v
!!! Position
0)
  {-# INLINE bitLength #-}

instance BitLength (DVS.Vector Word64) where
  bitLength :: Vector Count -> Count
bitLength Vector Count
v = Vector Count -> Count
forall v. Length v => v -> Count
length Vector Count
v Count -> Count -> Count
forall a. Num a => a -> a -> a
* Count -> Count
forall v. BitLength v => v -> Count
bitLength (Vector Count
v Vector Count -> Position -> Elem (Vector Count)
forall v. AtIndex v => v -> Position -> Elem v
!!! Position
0)
  {-# INLINE bitLength #-}

instance BitLength (DVU.Vector Bit.Bit) where
  bitLength :: Vector Bit -> Count
bitLength = Int -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Count) -> (Vector Bit -> Int) -> Vector Bit -> Count
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Bit -> Int
forall a. Unbox a => Vector a -> Int
DVU.length
  {-# INLINE bitLength #-}

instance BitLength (DVU.Vector BitTS.Bit) where
  bitLength :: Vector Bit -> Count
bitLength = Int -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Count) -> (Vector Bit -> Int) -> Vector Bit -> Count
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Bit -> Int
forall a. Unbox a => Vector a -> Int
DVU.length
  {-# INLINE bitLength #-}