{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE RankNTypes           #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Data.Flat.Bits (
    Bits,
    toBools,
    fromBools,
    bits,
    paddedBits,
    asBytes,
    asBits,
    ) where
import           Data.Bits                      hiding (Bits)
import qualified Data.ByteString                as B
import           Data.Flat.Class
import           Data.Flat.Decoder
import           Data.Flat.Filler
import           Data.Flat.Run
import qualified Data.Vector.Unboxed            as V
import           Data.Word
import           Text.PrettyPrint.HughesPJClass
type Bits = V.Vector Bool
toBools :: Bits -> [Bool]
toBools = V.toList
fromBools :: [Bool] -> Bits
fromBools = V.fromList
bits :: forall a. Flat a => a -> Bits
bits v = let lbs = flat v
             Right (PostAligned _ f) = unflatRaw lbs :: Decoded (PostAligned a)
         in takeBits (8 * B.length lbs - fillerLength f) lbs
paddedBits :: forall a. Flat a => a -> Bits
paddedBits v = let lbs = flat v
               in takeBits (8 * B.length lbs) lbs
takeBits :: Int -> B.ByteString -> Bits
takeBits numBits lbs  = V.generate (fromIntegral numBits) (\n -> let (bb,b) = n `divMod` 8 in testBit (B.index lbs (fromIntegral bb)) (7-b))
asBits :: FiniteBits a => a -> Bits
asBits w = let s = finiteBitSize w in V.generate s (testBit w . (s-1-))
asBytes :: Bits -> [Word8]
asBytes = map byteVal . bytes .  V.toList
byteVal :: [Bool] -> Word8
byteVal = sum . map (\(e,b) -> if b then e else 0). zip [2 ^ n | n <- [7::Int,6..0]]
bytes :: [t] -> [[t]]
bytes [] = []
bytes l  = let (w,r) = splitAt 8 l in w : bytes r
instance Pretty Bits where pPrint = hsep . map prettyBits . bytes .  V.toList
prettyBits :: Foldable t => t Bool -> Doc
prettyBits l = text . take (length l) . concatMap (\b -> if b then "1" else "0") $ l