{-# 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.Vector          as DV
import qualified Data.Vector.Storable as DVS

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 = toPosition . bitLength
  {-# INLINE endPosition #-}

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

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

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

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

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

instance BitLength [Bool] where
  bitLength = fromIntegral . length
  {-# INLINE bitLength #-}

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

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

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

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

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

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

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

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

instance BitLength [Word8] where
  bitLength v = fromIntegral (length v) * bitLength (head v)
  {-# INLINE bitLength #-}

instance BitLength [Word16] where
  bitLength v = fromIntegral (length v) * bitLength (head v)
  {-# INLINE bitLength #-}

instance BitLength [Word32] where
  bitLength v = fromIntegral (length v) * bitLength (head v)
  {-# INLINE bitLength #-}

instance BitLength [Word64] where
  bitLength v = fromIntegral (length v) * bitLength (head v)
  {-# INLINE bitLength #-}

instance BitLength (DV.Vector Word8) where
  bitLength v = length v * bitLength (v !!! 0)
  {-# INLINE bitLength #-}

instance BitLength (DV.Vector Word16) where
  bitLength v = length v * bitLength (v !!! 0)
  {-# INLINE bitLength #-}

instance BitLength (DV.Vector Word32) where
  bitLength v = length v * bitLength (v !!! 0)
  {-# INLINE bitLength #-}

instance BitLength (DV.Vector Word64) where
  bitLength v = length v * bitLength (v !!! 0)
  {-# INLINE bitLength #-}

instance BitLength (DVS.Vector Word8) where
  bitLength v = length v * bitLength (v !!! 0)
  {-# INLINE bitLength #-}

instance BitLength (DVS.Vector Word16) where
  bitLength v = length v * bitLength (v !!! 0)
  {-# INLINE bitLength #-}

instance BitLength (DVS.Vector Word32) where
  bitLength v = length v * bitLength (v !!! 0)
  {-# INLINE bitLength #-}

instance BitLength (DVS.Vector Word64) where
  bitLength v = length v * bitLength (v !!! 0)
  {-# INLINE bitLength #-}