{-# LANGUAGE CPP #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TupleSections #-}

module Codec.QRCode.Data.ByteStreamBuilder
  ( ByteStreamBuilder
  , encodeBits
  , toList
  , Codec.QRCode.Data.ByteStreamBuilder.length
  , Codec.QRCode.Data.ByteStreamBuilder.null
  , fromList
  , toBitStream
  ) where

import           Codec.QRCode.Base

import qualified Data.DList        as DL

-- | List of bits. Stored as a pair of Int, how many bits to store and the data, in a DList.
--   The DList gives a O(1) append.
--   The number of bits in a pair is never more than 22.
newtype ByteStreamBuilder
  = ByteStreamBuilder
    { ByteStreamBuilder -> DList (Int, Int)
unBitStreamBuilder :: DL.DList (Int, Int)
    }

instance Semigroup ByteStreamBuilder where
  {-# INLINE (<>) #-}
  ByteStreamBuilder DList (Int, Int)
a <> :: ByteStreamBuilder -> ByteStreamBuilder -> ByteStreamBuilder
<> ByteStreamBuilder DList (Int, Int)
b = DList (Int, Int) -> ByteStreamBuilder
ByteStreamBuilder (DList (Int, Int)
a forall a. DList a -> DList a -> DList a
`DL.append` DList (Int, Int)
b)

instance Monoid ByteStreamBuilder where
  {-# INLINE mempty #-}
  mempty :: ByteStreamBuilder
mempty = DList (Int, Int) -> ByteStreamBuilder
ByteStreamBuilder forall a. Monoid a => a
mempty
#if !(MIN_VERSION_base(4,11,0))
  {-# INLINE mappend #-}
  mappend = (<>)
#endif

-- | Store bits from Int in an ByteStreamBuilder
encodeBits :: Int -> Int -> ByteStreamBuilder
encodeBits :: Int -> Int -> ByteStreamBuilder
encodeBits Int
n Int
b
  | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. Monoid a => a
mempty
  | Int
n forall a. Ord a => a -> a -> Bool
> Int
22 = Int -> Int -> ByteStreamBuilder
encodeBits (Int
nforall a. Num a => a -> a -> a
-Int
16) (Int
b forall a. Bits a => a -> Int -> a
`shiftR` Int
16) forall a. Semigroup a => a -> a -> a
<> Int -> Int -> ByteStreamBuilder
encodeBits Int
16 Int
b
  | Bool
otherwise = DList (Int, Int) -> ByteStreamBuilder
ByteStreamBuilder (forall a. a -> DList a
DL.singleton (Int
n, Int
b forall a. Bits a => a -> a -> a
.&. (forall a. Bits a => Int -> a
bit Int
n forall a. Num a => a -> a -> a
- Int
1)))

-- | Store bits from an list of Bytes in an ByteStreamBuilder
fromList :: [Word8] -> ByteStreamBuilder
{-# INLINEABLE fromList #-}
fromList :: [Word8] -> ByteStreamBuilder
fromList = DList (Int, Int) -> ByteStreamBuilder
ByteStreamBuilder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> DList a
DL.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ((Int
8,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral)

length :: ByteStreamBuilder -> Int
{-# INLINEABLE length #-}
length :: ByteStreamBuilder -> Int
length = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DList a -> [a]
DL.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteStreamBuilder -> DList (Int, Int)
unBitStreamBuilder

null :: ByteStreamBuilder -> Bool
{-# INLINE null #-}
null :: ByteStreamBuilder -> Bool
null = forall (t :: * -> *) a. Foldable t => t a -> Bool
Codec.QRCode.Base.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DList a -> [a]
DL.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteStreamBuilder -> DList (Int, Int)
unBitStreamBuilder

-- | Convert ByteStreamBuilder to list of Word8
toList :: ByteStreamBuilder -> [Word8]
toList :: ByteStreamBuilder -> [Word8]
toList = Int -> Int -> [(Int, Int)] -> [Word8]
go Int
0 Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DList a -> [a]
DL.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteStreamBuilder -> DList (Int, Int)
unBitStreamBuilder
  where
    go :: Int -> Int -> [(Int, Int)] -> [Word8]
    go :: Int -> Int -> [(Int, Int)] -> [Word8]
go Int
n Int
b [(Int, Int)]
xs
      | Int
n forall a. Ord a => a -> a -> Bool
>= Int
8 =
        forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
b forall a. Bits a => a -> Int -> a
`shiftR` (Int
nforall a. Num a => a -> a -> a
-Int
8)) forall a. a -> [a] -> [a]
: Int -> Int -> [(Int, Int)] -> [Word8]
go (Int
nforall a. Num a => a -> a -> a
-Int
8) Int
b [(Int, Int)]
xs
    go Int
n Int
_ ((Int
n', Int
b'):[(Int, Int)]
xs)
      | Int
n forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
n' forall a. Eq a => a -> a -> Bool
== Int
8 =
        forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b' forall a. a -> [a] -> [a]
: Int -> Int -> [(Int, Int)] -> [Word8]
go Int
0 Int
0 [(Int, Int)]
xs -- short circut if we have currently 0 bits and the next chunk contains 8 bits
    go Int
n Int
b ((Int
n', Int
b'):[(Int, Int)]
xs) =
      Int -> Int -> [(Int, Int)] -> [Word8]
go (Int
nforall a. Num a => a -> a -> a
+Int
n') ((Int
b forall a. Bits a => a -> Int -> a
`shiftL` Int
n') forall a. Bits a => a -> a -> a
.|. Int
b') [(Int, Int)]
xs -- maximum leftover: 7, maximum new bits: 22, result is < 30 bits (what a Int can store at least)
    go Int
_ Int
_ [] = []

-- | Convert list of Word8 to list of Bool
toBitStream :: [Word8] -> [Bool]
toBitStream :: [Word8] -> [Bool]
toBitStream (Word8
x:[Word8]
xs) =
    (Word8
x forall a. Bits a => a -> a -> a
.&. Word8
128 forall a. Eq a => a -> a -> Bool
/= Word8
0)
  forall a. a -> [a] -> [a]
: (Word8
x forall a. Bits a => a -> a -> a
.&.  Word8
64 forall a. Eq a => a -> a -> Bool
/= Word8
0)
  forall a. a -> [a] -> [a]
: (Word8
x forall a. Bits a => a -> a -> a
.&.  Word8
32 forall a. Eq a => a -> a -> Bool
/= Word8
0)
  forall a. a -> [a] -> [a]
: (Word8
x forall a. Bits a => a -> a -> a
.&.  Word8
16 forall a. Eq a => a -> a -> Bool
/= Word8
0)
  forall a. a -> [a] -> [a]
: (Word8
x forall a. Bits a => a -> a -> a
.&.   Word8
8 forall a. Eq a => a -> a -> Bool
/= Word8
0)
  forall a. a -> [a] -> [a]
: (Word8
x forall a. Bits a => a -> a -> a
.&.   Word8
4 forall a. Eq a => a -> a -> Bool
/= Word8
0)
  forall a. a -> [a] -> [a]
: (Word8
x forall a. Bits a => a -> a -> a
.&.   Word8
2 forall a. Eq a => a -> a -> Bool
/= Word8
0)
  forall a. a -> [a] -> [a]
: (Word8
x forall a. Bits a => a -> a -> a
.&.   Word8
1 forall a. Eq a => a -> a -> Bool
/= Word8
0)
  forall a. a -> [a] -> [a]
: [Word8] -> [Bool]
toBitStream [Word8]
xs
toBitStream [] = []