{-# 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 DList (Int, Int) -> DList (Int, Int) -> DList (Int, Int)
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 DList (Int, Int)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ByteStreamBuilder
forall a. Monoid a => a
mempty
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
22 = Int -> Int -> ByteStreamBuilder
encodeBits (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
16) (Int
b Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) ByteStreamBuilder -> ByteStreamBuilder -> ByteStreamBuilder
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> ByteStreamBuilder
encodeBits Int
16 Int
b
  | Bool
otherwise = DList (Int, Int) -> ByteStreamBuilder
ByteStreamBuilder ((Int, Int) -> DList (Int, Int)
forall a. a -> DList a
DL.singleton (Int
n, Int
b Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. (Int -> Int
forall a. Bits a => Int -> a
bit Int
n Int -> Int -> Int
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 (DList (Int, Int) -> ByteStreamBuilder)
-> ([Word8] -> DList (Int, Int)) -> [Word8] -> ByteStreamBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Int)] -> DList (Int, Int)
forall a. [a] -> DList a
DL.fromList ([(Int, Int)] -> DList (Int, Int))
-> ([Word8] -> [(Int, Int)]) -> [Word8] -> DList (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> (Int, Int)) -> [Word8] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int
8,) (Int -> (Int, Int)) -> (Word8 -> Int) -> Word8 -> (Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

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

null :: ByteStreamBuilder -> Bool
{-# INLINE null #-}
null :: ByteStreamBuilder -> Bool
null = [(Int, Int)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Codec.QRCode.Base.null ([(Int, Int)] -> Bool)
-> (ByteStreamBuilder -> [(Int, Int)]) -> ByteStreamBuilder -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList (Int, Int) -> [(Int, Int)]
forall a. DList a -> [a]
DL.toList (DList (Int, Int) -> [(Int, Int)])
-> (ByteStreamBuilder -> DList (Int, Int))
-> ByteStreamBuilder
-> [(Int, Int)]
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 ([(Int, Int)] -> [Word8])
-> (ByteStreamBuilder -> [(Int, Int)])
-> ByteStreamBuilder
-> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList (Int, Int) -> [(Int, Int)]
forall a. DList a -> [a]
DL.toList (DList (Int, Int) -> [(Int, Int)])
-> (ByteStreamBuilder -> DList (Int, Int))
-> ByteStreamBuilder
-> [(Int, Int)]
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
8 =
        Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
b Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
8)) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: Int -> Int -> [(Int, Int)] -> [Word8]
go (Int
nInt -> Int -> Int
forall 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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
n' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8 =
        Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b' Word8 -> [Word8] -> [Word8]
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
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n') ((Int
b Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
n') Int -> Int -> Int
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 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
128 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0)
  Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: (Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&.  Word8
64 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0)
  Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: (Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&.  Word8
32 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0)
  Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: (Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&.  Word8
16 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0)
  Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: (Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&.   Word8
8 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0)
  Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: (Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&.   Word8
4 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0)
  Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: (Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&.   Word8
2 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0)
  Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: (Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&.   Word8
1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0)
  Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Word8] -> [Bool]
toBitStream [Word8]
xs
toBitStream [] = []