module HaskellWorks.Data.PackedVector.Internal
  ( packBits
  , packBits'
  , unpackBits
  , unpackBits'
  ) where

import Data.Word
import HaskellWorks.Data.Bits.BitWise
import HaskellWorks.Data.Bits.FixedBitSize
import HaskellWorks.Data.Bits.LoBitsSized
import HaskellWorks.Data.Positioning

{- HLINT ignore "Reduce duplication"  -}

class Integral a => PackBits a where
  packBits :: Count -> [a] -> [a]
  packBits = Count -> a -> Count -> [a] -> [a]
forall a. PackBits a => Count -> a -> Count -> [a] -> [a]
packBits' Count
0 a
0

  packBits' :: Count -> a -> Count -> [a] -> [a]

class Integral a => UnpackBits a where
  unpackBits :: Int -> Count -> [a] -> [a]
  unpackBits = Count -> a -> Int -> Count -> [a] -> [a]
forall a. UnpackBits a => Count -> a -> Int -> Count -> [a] -> [a]
unpackBits' Count
0 a
0

  unpackBits' :: Count -> a -> Int -> Count -> [a] -> [a]

instance PackBits Word64 where
  packBits' :: Count -> Count -> Count -> [Count] -> [Count]
packBits' Count
filled Count
carry Count
bitLen (Count
w:[Count]
ws) = if Count
fillNeeded Count -> Count -> Bool
forall a. Ord a => a -> a -> Bool
< Count -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Count -> Count
forall a. FixedBitSize a => a -> Count
fixedBitSize Count
carry)
      then Count -> Count -> Count -> [Count] -> [Count]
forall a. PackBits a => Count -> a -> Count -> [a] -> [a]
packBits' Count
fillNeeded Count
newV Count
bitLen [Count]
ws
      else Count
newV Count -> [Count] -> [Count]
forall a. a -> [a] -> [a]
: Count -> Count -> Count -> [Count] -> [Count]
forall a. PackBits a => Count -> a -> Count -> [a] -> [a]
packBits' Count
fillLeft Count
carryV Count
bitLen [Count]
ws
    where fillNeeded :: Count
fillNeeded  = Count
filled Count -> Count -> Count
forall a. Num a => a -> a -> a
+ Count
bitLen
          fillMet :: Count
fillMet     = Count
fillNeeded Count -> Count -> Count
forall a. Ord a => a -> a -> a
`min` Count -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Count -> Count
forall a. FixedBitSize a => a -> Count
fixedBitSize Count
carry)
          fillLeft :: Count
fillLeft    = Count
fillNeeded Count -> Count -> Count
forall a. Num a => a -> a -> a
- Count
fillMet
          bitMet :: Count
bitMet      = Count -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Count
fillMet Count -> Count -> Count
forall a. Num a => a -> a -> a
- Count
filled) :: Count
          newV :: Count
newV        = Count
carry Count -> Count -> Count
forall a. BitWise a => a -> a -> a
.|. ((Count
w Count -> Count -> Count
forall a. BitWise a => a -> a -> a
.&. Count -> Count
forall a. LoBitsSized a => Count -> a
loBitsSized Count
bitMet) Count -> Count -> Count
forall a. Shift a => a -> Count -> a
.<. Count -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral Count
filled)
          carryV :: Count
carryV      = Count
w Count -> Count -> Count
forall a. Shift a => a -> Count -> a
.>. Count
bitMet
  packBits' Count
_ Count
carry Count
_ [Count]
_ = [Count
carry]

instance UnpackBits Word64 where
  unpackBits' :: Count -> Count -> Int -> Count -> [Count] -> [Count]
unpackBits' Count
_ Count
_ Int
0 Count
_ [Count]
_ = []
  unpackBits' Count
filled Count
carry Int
dataLen Count
bitLen [Count]
ws | Count
filled Count -> Count -> Bool
forall a. Ord a => a -> a -> Bool
>= Count
bitLen =
    let result :: [Count]
result = (Count
carry Count -> Count -> Count
forall a. BitWise a => a -> a -> a
.&. Count -> Count
forall a. LoBitsSized a => Count -> a
loBitsSized Count
bitLen) Count -> [Count] -> [Count]
forall a. a -> [a] -> [a]
: Count -> Count -> Int -> Count -> [Count] -> [Count]
forall a. UnpackBits a => Count -> a -> Int -> Count -> [a] -> [a]
unpackBits' (Count
filled Count -> Count -> Count
forall a. Num a => a -> a -> a
- Count
bitLen) (Count
carry Count -> Count -> Count
forall a. Shift a => a -> Count -> a
.>. Count -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral Count
bitLen) (Int
dataLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Count
bitLen [Count]
ws in
    [Count]
result
  unpackBits' Count
filled Count
carry Int
dataLen Count
bitLen (Count
w:[Count]
ws) =
    let bitsNeeded :: Count
bitsNeeded = Count
bitLen Count -> Count -> Count
forall a. Num a => a -> a -> a
- Count
filled                    in
    let newValue :: Count
newValue = Count
carry Count -> Count -> Count
forall a. BitWise a => a -> a -> a
.|. ((Count
w Count -> Count -> Count
forall a. BitWise a => a -> a -> a
.&. Count -> Count
forall a. LoBitsSized a => Count -> a
loBitsSized Count
bitsNeeded) Count -> Count -> Count
forall a. Shift a => a -> Count -> a
.<. Count -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral Count
filled) in
    Count
newValue Count -> [Count] -> [Count]
forall a. a -> [a] -> [a]
: Count -> Count -> Int -> Count -> [Count] -> [Count]
forall a. UnpackBits a => Count -> a -> Int -> Count -> [a] -> [a]
unpackBits' (Count -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Count -> Count
forall a. FixedBitSize a => a -> Count
fixedBitSize Count
carry) Count -> Count -> Count
forall a. Num a => a -> a -> a
- Count
bitsNeeded) (Count
w Count -> Count -> Count
forall a. Shift a => a -> Count -> a
.>. Count -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral Count
bitsNeeded) (Int
dataLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Count
bitLen [Count]
ws
  unpackBits' Count
_ Count
_ Int
_ Count
_ [Count]
_ = []

instance PackBits Word8 where
  packBits' :: Count -> Word8 -> Count -> [Word8] -> [Word8]
packBits' Count
filled Word8
carry Count
bitLen (Word8
w:[Word8]
ws) = if Count
fillNeeded Count -> Count -> Bool
forall a. Ord a => a -> a -> Bool
< Count -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Count
forall a. FixedBitSize a => a -> Count
fixedBitSize Word8
carry)
      then Count -> Word8 -> Count -> [Word8] -> [Word8]
forall a. PackBits a => Count -> a -> Count -> [a] -> [a]
packBits' Count
fillNeeded Word8
newV Count
bitLen [Word8]
ws
      else Word8
newV Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: Count -> Word8 -> Count -> [Word8] -> [Word8]
forall a. PackBits a => Count -> a -> Count -> [a] -> [a]
packBits' Count
fillLeft Word8
carryV Count
bitLen [Word8]
ws
    where fillNeeded :: Count
fillNeeded  = Count
filled Count -> Count -> Count
forall a. Num a => a -> a -> a
+ Count
bitLen
          fillMet :: Count
fillMet     = Count
fillNeeded Count -> Count -> Count
forall a. Ord a => a -> a -> a
`min` Count -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Count
forall a. FixedBitSize a => a -> Count
fixedBitSize Word8
carry)
          fillLeft :: Count
fillLeft    = Count
fillNeeded Count -> Count -> Count
forall a. Num a => a -> a -> a
- Count
fillMet
          bitMet :: Count
bitMet      = Count -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Count
fillMet Count -> Count -> Count
forall a. Num a => a -> a -> a
- Count
filled) :: Count
          newV :: Word8
newV        = Word8
carry Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.|. ((Word8
w Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.&. Count -> Word8
forall a. LoBitsSized a => Count -> a
loBitsSized Count
bitMet) Word8 -> Count -> Word8
forall a. Shift a => a -> Count -> a
.<. Count -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral Count
filled)
          carryV :: Word8
carryV      = Word8
w Word8 -> Count -> Word8
forall a. Shift a => a -> Count -> a
.>. Count -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral Count
bitMet
  packBits' Count
_ Word8
carry Count
_ [Word8]
_ = [Word8
carry]

instance UnpackBits Word8 where
  unpackBits' :: Count -> Word8 -> Int -> Count -> [Word8] -> [Word8]
unpackBits' Count
_ Word8
_ Int
0 Count
_ [Word8]
_ = []
  unpackBits' Count
filled Word8
carry Int
dataLen Count
bitLen [Word8]
ws | Count
filled Count -> Count -> Bool
forall a. Ord a => a -> a -> Bool
>= Count
bitLen =
    (Word8
carry Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.&. Count -> Word8
forall a. LoBitsSized a => Count -> a
loBitsSized Count
bitLen) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: Count -> Word8 -> Int -> Count -> [Word8] -> [Word8]
forall a. UnpackBits a => Count -> a -> Int -> Count -> [a] -> [a]
unpackBits' (Count
filled Count -> Count -> Count
forall a. Num a => a -> a -> a
- Count
bitLen) (Word8
carry Word8 -> Count -> Word8
forall a. Shift a => a -> Count -> a
.>. Count -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral Count
bitLen) (Int
dataLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Count
bitLen [Word8]
ws
  unpackBits' Count
filled Word8
carry Int
dataLen Count
bitLen (Word8
w:[Word8]
ws) =
    let bitsNeeded :: Count
bitsNeeded = Count
bitLen Count -> Count -> Count
forall a. Num a => a -> a -> a
- Count
filled                    in
    let newValue :: Word8
newValue = Word8
carry Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.|. ((Word8
w Word8 -> Word8 -> Word8
forall a. BitWise a => a -> a -> a
.&. Count -> Word8
forall a. LoBitsSized a => Count -> a
loBitsSized Count
bitsNeeded) Word8 -> Count -> Word8
forall a. Shift a => a -> Count -> a
.<. Count -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral Count
filled) in
    let result :: [Word8]
result = Word8
newValue Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: Count -> Word8 -> Int -> Count -> [Word8] -> [Word8]
forall a. UnpackBits a => Count -> a -> Int -> Count -> [a] -> [a]
unpackBits' (Count
8 Count -> Count -> Count
forall a. Num a => a -> a -> a
- Count
bitsNeeded) (Word8
w Word8 -> Count -> Word8
forall a. Shift a => a -> Count -> a
.>. Count -> Count
forall a b. (Integral a, Num b) => a -> b
fromIntegral Count
bitsNeeded) (Int
dataLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Count
bitLen [Word8]
ws in
    [Word8]
result
  unpackBits' Count
_ Word8
_ Int
_ Count
_ [Word8]
_ = []