{-# LANGUAGE CPP #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TupleSections #-}
module Codec.QRCode.Data.ByteStreamBuilder
( ByteStreamBuilder
, encodeBits
, toList
, Codec.QRCode.Data.ByteStreamBuilder.length
, fromList
, toBitStream
) where
import Codec.QRCode.Base
import qualified Data.DList as DL
newtype ByteStreamBuilder
= ByteStreamBuilder
{ unBitStreamBuilder :: DL.DList (Int, Int)
}
instance Semigroup ByteStreamBuilder where
{-# INLINE (<>) #-}
ByteStreamBuilder a <> ByteStreamBuilder b = ByteStreamBuilder (a `DL.append` b)
instance Monoid ByteStreamBuilder where
{-# INLINE mempty #-}
mempty = ByteStreamBuilder mempty
#if !(MIN_VERSION_base(4,11,0))
{-# INLINE mappend #-}
mappend = (<>)
#endif
encodeBits :: Int -> Int -> ByteStreamBuilder
encodeBits n b
| n <= 0 = mempty
| n > 22 = encodeBits (n-16) (b `shiftR` 16) <> encodeBits 16 b
| otherwise = ByteStreamBuilder (DL.singleton (n, b .&. (bit n - 1)))
fromList :: [Word8] -> ByteStreamBuilder
{-# INLINEABLE fromList #-}
fromList = ByteStreamBuilder . DL.fromList . map ((8,) . fromIntegral)
length :: ByteStreamBuilder -> Int
{-# INLINEABLE length #-}
length = sum . map fst . DL.toList . unBitStreamBuilder
toList :: ByteStreamBuilder -> [Word8]
toList = go 0 0 . DL.toList . unBitStreamBuilder
where
go :: Int -> Int -> [(Int, Int)] -> [Word8]
go n b xs
| n >= 8 =
fromIntegral (b `shiftR` (n-8)) : go (n-8) b xs
go n _ ((n', b'):xs)
| n == 0 && n' == 8 =
fromIntegral b' : go 0 0 xs
go n b ((n', b'):xs) =
go (n+n') ((b `shiftL` n') .|. b') xs
go _ _ [] = []
toBitStream :: [Word8] -> [Bool]
toBitStream (x:xs) =
(x .&. 128 /= 0)
: (x .&. 64 /= 0)
: (x .&. 32 /= 0)
: (x .&. 16 /= 0)
: (x .&. 8 /= 0)
: (x .&. 4 /= 0)
: (x .&. 2 /= 0)
: (x .&. 1 /= 0)
: toBitStream xs
toBitStream [] = []