{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RecordWildCards #-}

module Codec.QRCode.Code.Data
  ( qrSize
  , QRInternal
  , calcVersionAndErrorLevel
  , appendEndAndPadding
  , appendErrorCorrection
  ) where

import           Codec.QRCode.Base

import qualified Data.Vector.Unboxed                       as UV

import           Codec.QRCode.Code.ReedSolomonEncoder
import qualified Codec.QRCode.Data.ByteStreamBuilder       as BSB
import           Codec.QRCode.Data.ErrorLevel
import           Codec.QRCode.Data.Mask
import           Codec.QRCode.Data.QRCodeOptions
import           Codec.QRCode.Data.QRIntermediate.Internal
import           Codec.QRCode.Data.QRSegment.Internal
import           Codec.QRCode.Data.Result
import           Codec.QRCode.Data.Version

-- | Calculates the size of a QR code (in modules) based on the version.
qrSize :: Version -> Int
{-# INLINE qrSize #-}
qrSize :: Version -> Int
qrSize Version
ver = Int
17 forall a. Num a => a -> a -> a
+ Version -> Int
unVersion Version
ver forall a. Num a => a -> a -> a
* Int
4

-- | The data all encoder pass around
type QRInternal t = (Version, ErrorLevel, t, Maybe Mask)

-- | Determine `Version` and `ErrorLevel` based on the `QRCodeOptions` and the data to encode.
calcVersionAndErrorLevel :: QRCodeOptions -> QRSegment -> Result QRIntermediate
calcVersionAndErrorLevel :: QRCodeOptions -> QRSegment -> Result QRIntermediate
calcVersionAndErrorLevel QRCodeOptions{Bool
Int
Maybe Mask
ErrorLevel
qroMask :: QRCodeOptions -> Maybe Mask
qroBoostErrorLevel :: QRCodeOptions -> Bool
qroErrorLevel :: QRCodeOptions -> ErrorLevel
qroMaxVersion :: QRCodeOptions -> Int
qroMinVersion :: QRCodeOptions -> Int
qroMask :: Maybe Mask
qroBoostErrorLevel :: Bool
qroErrorLevel :: ErrorLevel
qroMaxVersion :: Int
qroMinVersion :: Int
..} QRSegment
input =
  -- Run though all tree `VersionRange`s and return the first matching.
  -- This ensures that the input stream is only encoded once per `VersionRange` and not for each `Version`.
  forall a b. (a -> Result b) -> [a] -> Result b
firstSuccess VersionRange -> Result QRIntermediate
checkSizeVR [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]
  where
    -- Run though all `Version`s of the `VersionRange` which are permitted by the options and return the first matching.
    checkSizeVR :: VersionRange -> Result QRIntermediate
    checkSizeVR :: VersionRange -> Result QRIntermediate
checkSizeVR VersionRange
vr = do
      let
        versions :: [Version]
versions = VersionRange -> Int -> Int -> [Version]
versionsInRangeLimitedBy VersionRange
vr Int
qroMinVersion Int
qroMaxVersion
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Version]
versions))
      ByteStreamBuilder
stream <- QRSegment -> VersionRange -> Result ByteStreamBuilder
unQRSegment QRSegment
input VersionRange
vr
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (ByteStreamBuilder -> Bool
BSB.null ByteStreamBuilder
stream))
      forall a b. (a -> Result b) -> [a] -> Result b
firstSuccess (ByteStreamBuilder -> Version -> Result QRIntermediate
checkSize ByteStreamBuilder
stream) [Version]
versions
    -- Check if the data fits into a specific `Version`.
    checkSize :: BSB.ByteStreamBuilder -> Version -> Result QRIntermediate
    checkSize :: ByteStreamBuilder -> Version -> Result QRIntermediate
checkSize ByteStreamBuilder
bs Version
v = do
      let
        bsl :: Int
bsl = ByteStreamBuilder -> Int
BSB.length ByteStreamBuilder
bs
      -- Try all allowed `ErrorLevel`s and chose the one with most error correction which fits the data.
      ErrorLevel
el <- forall a. (a -> Bool) -> [a] -> Result a
firstMatch (\ErrorLevel
e -> Int
bsl forall a. Ord a => a -> a -> Bool
<= Int
8 forall a. Num a => a -> a -> a
* Version -> ErrorLevel -> Int
numDataCodeWords Version
v ErrorLevel
e) [ErrorLevel]
errorLevels
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        Version
-> ErrorLevel
-> Int
-> ByteStreamBuilder
-> Maybe Mask
-> QRIntermediate
QRIntermediate Version
v ErrorLevel
el Int
bsl ByteStreamBuilder
bs Maybe Mask
qroMask
    -- Allowed `ErrorLevel`s: Either just one, or the specified and all with "better" error correction if boost is selected.
    errorLevels :: [ErrorLevel]
    errorLevels :: [ErrorLevel]
errorLevels
      | Bool
qroBoostErrorLevel = [ErrorLevel
H, ErrorLevel
Q .. ErrorLevel
qroErrorLevel]
      | Bool
otherwise = [ErrorLevel
qroErrorLevel]
    -- Helper to pick the first successful calculation.
    firstSuccess :: (a -> Result b) -> [a] -> Result b
    firstSuccess :: forall a b. (a -> Result b) -> [a] -> Result b
firstSuccess a -> Result b
fn = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Result b
fn) forall (f :: * -> *) a. Alternative f => f a
empty
    -- Helper to pick the first matching result.
    firstMatch :: (a -> Bool) -> [a] -> Result a
    firstMatch :: forall a. (a -> Bool) -> [a] -> Result a
firstMatch a -> Bool
fn = forall a b. (a -> Result b) -> [a] -> Result b
firstSuccess (\a
e -> forall a. a -> a -> Bool -> a
bool forall (f :: * -> *) a. Alternative f => f a
empty (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
e) (a -> Bool
fn a
e))

-- | Add the End marker, pad to a full byte (with 0) and pad all further unused bytes (with 0xEC11).
appendEndAndPadding :: QRIntermediate -> QRInternal BSB.ByteStreamBuilder
appendEndAndPadding :: QRIntermediate -> QRInternal ByteStreamBuilder
appendEndAndPadding (QRIntermediate Version
v ErrorLevel
e Int
bsl ByteStreamBuilder
bs Maybe Mask
mmask) =
  let
    -- Capacity of the data part
    capacity :: Int
capacity = Int
8 forall a. Num a => a -> a -> a
* Version -> ErrorLevel -> Int
numDataCodeWords Version
v ErrorLevel
e
    -- The number of End bits to add (may be less than 4 if there is not enough space)
    endLen :: Int
endLen = Int
4 forall a. Ord a => a -> a -> a
`min` (Int
capacity forall a. Num a => a -> a -> a
- Int
bsl)
    -- Pad until a full Byte
    pad0Len :: Int
pad0Len = forall a. Num a => a -> a
negate (Int
bsl forall a. Num a => a -> a -> a
+ Int
endLen) forall a. Integral a => a -> a -> a
`mod` Int
8
    -- Pad all other unused Bytes
    padEC11Len :: Int
padEC11Len = Int
capacity forall a. Num a => a -> a -> a
- (Int
bsl forall a. Num a => a -> a -> a
+ Int
endLen forall a. Num a => a -> a -> a
+ Int
pad0Len)
  in
    (Version
v, ErrorLevel
e, ByteStreamBuilder
bs forall a. Semigroup a => a -> a -> a
<> Int -> Int -> ByteStreamBuilder
BSB.encodeBits (Int
endLen forall a. Num a => a -> a -> a
+ Int
pad0Len) Int
0 forall a. Semigroup a => a -> a -> a
<> [Word8] -> ByteStreamBuilder
BSB.fromList (forall a. Int -> [a] -> [a]
take (Int
padEC11Len forall a. Integral a => a -> a -> a
`div` Int
8) (forall a. [a] -> [a]
cycle [Word8
0xec, Word8
0x11])), Maybe Mask
mmask)

-- | Append the appropriate error correction to the data.
appendErrorCorrection :: QRInternal BSB.ByteStreamBuilder -> QRInternal [Word8]
appendErrorCorrection :: QRInternal ByteStreamBuilder -> QRInternal [Word8]
appendErrorCorrection (Version
v, ErrorLevel
e, ByteStreamBuilder
bs, Maybe Mask
mmask) =
  let
    numBlocks :: Int
numBlocks = Version -> ErrorLevel -> Int
numErrorCorrectionBlocks Version
v ErrorLevel
e
    blockEccLen :: Int
blockEccLen = Version -> ErrorLevel -> Int
eccCodeWordsPerBlock Version
v ErrorLevel
e
    rawCodeWords :: Int
rawCodeWords = Version -> Int
numRawDataModules Version
v forall a. Integral a => a -> a -> a
`div` Int
8
    numShortBlocks :: Int
numShortBlocks = Int
numBlocks forall a. Num a => a -> a -> a
- (Int
rawCodeWords forall a. Integral a => a -> a -> a
`mod` Int
numBlocks)
    shortBlockLen :: Int
shortBlockLen = Int
rawCodeWords forall a. Integral a => a -> a -> a
`div` Int
numBlocks
    generatorPolynomial :: RsGeneratorPolynomial
generatorPolynomial = Int -> RsGeneratorPolynomial
rsGeneratorPolynomial Int
blockEccLen
    dataBlockLens :: [Int]
dataBlockLens = [Int
shortBlockLen forall a. Num a => a -> a -> a
- Int
blockEccLen forall a. Num a => a -> a -> a
+ forall a. a -> a -> Bool -> a
bool Int
0 Int
1 (Int
x forall a. Ord a => a -> a -> Bool
>= Int
numShortBlocks) | Int
x <- [Int
0 .. Int
numBlocks forall a. Num a => a -> a -> a
- Int
1]]
    dataBlocks :: [[Word8]]
dataBlocks = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (\[Word8]
da Int
len -> forall a b. (a, b) -> (b, a)
swap (forall a. Int -> [a] -> ([a], [a])
splitAt Int
len [Word8]
da)) (ByteStreamBuilder -> [Word8]
BSB.toList ByteStreamBuilder
bs) [Int]
dataBlockLens
    eccBlocks :: [[Word8]]
eccBlocks = forall a b. (a -> b) -> [a] -> [b]
map (RsGeneratorPolynomial -> [Word8] -> [Word8]
rsEncode RsGeneratorPolynomial
generatorPolynomial) [[Word8]]
dataBlocks
    interleaved :: [[Word8]]
interleaved = forall a. [[a]] -> [[a]]
transpose [[Word8]]
dataBlocks forall a. [a] -> [a] -> [a]
++ forall a. [[a]] -> [[a]]
transpose [[Word8]]
eccBlocks
  in
    (Version
v, ErrorLevel
e, forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Word8]]
interleaved, Maybe Mask
mmask)

-- Returns the number of 8-bit data (i.e. not error correction) code words contained in any
-- QR Code of the given version number and error correction level, with remainder bits discarded.
numDataCodeWords :: Version -> ErrorLevel -> Int
{-# INLINABLE numDataCodeWords #-}
numDataCodeWords :: Version -> ErrorLevel -> Int
numDataCodeWords Version
v ErrorLevel
e =
  Version -> Int
numRawDataModules Version
v forall a. Integral a => a -> a -> a
`div` Int
8
  forall a. Num a => a -> a -> a
- Version -> ErrorLevel -> Int
eccCodeWordsPerBlock Version
v ErrorLevel
e
  forall a. Num a => a -> a -> a
* Version -> ErrorLevel -> Int
numErrorCorrectionBlocks Version
v ErrorLevel
e

-- Returns the number of bits that can be stored in a QR Code of the given version number, after
-- all function modules are excluded. This includes remainder bits, so it might not be a multiple of 8.
numRawDataModules :: Version -> Int
numRawDataModules :: Version -> Int
numRawDataModules Version
ver =
  let
    size :: Int
size = Version -> Int
qrSize Version
ver
    v2 :: Int
v2
      | Version -> Int
unVersion Version
ver forall a. Ord a => a -> a -> Bool
< Int
2 = Int
0
      | Bool
otherwise =
        let
          numAlign :: Int
numAlign = Version -> Int
unVersion Version
ver forall a. Integral a => a -> a -> a
`div` Int
7 forall a. Num a => a -> a -> a
+ Int
2
        in
           - (Int
numAlign forall a. Num a => a -> a -> a
- Int
1) forall a. Num a => a -> a -> a
* (Int
numAlign forall a. Num a => a -> a -> a
- Int
1) forall a. Num a => a -> a -> a
* Int
25 -- Subtract alignment patterns not overlapping with timing patterns
           forall a. Num a => a -> a -> a
- (Int
numAlign forall a. Num a => a -> a -> a
- Int
2) forall a. Num a => a -> a -> a
* Int
2 forall a. Num a => a -> a -> a
* Int
20 -- Subtract alignment patterns that overlap with timing patterns
    v7 :: Int
v7
      | Version -> Int
unVersion Version
ver forall a. Ord a => a -> a -> Bool
< Int
7 = Int
0
      | Bool
otherwise = - Int
18 forall a. Num a => a -> a -> a
* Int
2 -- Subtract version information
  in
    Int
size forall a. Num a => a -> a -> a
* Int
size -- Number of modules in the whole QR symbol square
    forall a. Num a => a -> a -> a
- Int
64 forall a. Num a => a -> a -> a
* Int
3 --  Subtract the three finders with separators
    forall a. Num a => a -> a -> a
- (Int
15 forall a. Num a => a -> a -> a
* Int
2 forall a. Num a => a -> a -> a
+ Int
1) --  Subtract the format information and black module
    forall a. Num a => a -> a -> a
- (Int
size forall a. Num a => a -> a -> a
- Int
16) forall a. Num a => a -> a -> a
* Int
2 -- Subtract the timing patterns
    forall a. Num a => a -> a -> a
+ Int
v2
    forall a. Num a => a -> a -> a
+ Int
v7

eccCodeWordsPerBlock :: Version -> ErrorLevel -> Int
{-# INLINE eccCodeWordsPerBlock #-}
eccCodeWordsPerBlock :: Version -> ErrorLevel -> Int
eccCodeWordsPerBlock Version
v ErrorLevel
e = Vector Int
eccCodeWordsPerBlockData forall a. Unbox a => Vector a -> Int -> a
UV.! (forall a. Enum a => a -> Int
fromEnum ErrorLevel
e forall a. Num a => a -> a -> a
* Int
40 forall a. Num a => a -> a -> a
+ Version -> Int
unVersion Version
v forall a. Num a => a -> a -> a
- Int
1)

eccCodeWordsPerBlockData :: UV.Vector Int
{-# NOINLINE eccCodeWordsPerBlockData #-}
eccCodeWordsPerBlockData :: Vector Int
eccCodeWordsPerBlockData =
  [ --1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40      Error correction level
      Int
7, Int
10, Int
15, Int
20, Int
26, Int
18, Int
20, Int
24, Int
30, Int
18, Int
20, Int
24, Int
26, Int
30, Int
22, Int
24, Int
28, Int
30, Int
28, Int
28, Int
28, Int
28, Int
30, Int
30, Int
26, Int
28, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30,  -- Low
     Int
10, Int
16, Int
26, Int
18, Int
24, Int
16, Int
18, Int
22, Int
22, Int
26, Int
30, Int
22, Int
22, Int
24, Int
24, Int
28, Int
28, Int
26, Int
26, Int
26, Int
26, Int
28, Int
28, Int
28, Int
28, Int
28, Int
28, Int
28, Int
28, Int
28, Int
28, Int
28, Int
28, Int
28, Int
28, Int
28, Int
28, Int
28, Int
28, Int
28,  -- Medium
     Int
13, Int
22, Int
18, Int
26, Int
18, Int
24, Int
18, Int
22, Int
20, Int
24, Int
28, Int
26, Int
24, Int
20, Int
30, Int
24, Int
28, Int
28, Int
26, Int
30, Int
28, Int
30, Int
30, Int
30, Int
30, Int
28, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30,  -- Quartile
     Int
17, Int
28, Int
22, Int
16, Int
22, Int
28, Int
26, Int
26, Int
24, Int
28, Int
24, Int
28, Int
22, Int
24, Int
24, Int
30, Int
28, Int
28, Int
26, Int
28, Int
30, Int
24, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30, Int
30   -- High
  ]

numErrorCorrectionBlocks :: Version -> ErrorLevel -> Int
{-# INLINE numErrorCorrectionBlocks #-}
numErrorCorrectionBlocks :: Version -> ErrorLevel -> Int
numErrorCorrectionBlocks Version
v ErrorLevel
e = Vector Int
numErrorCorrectionBlocksData forall a. Unbox a => Vector a -> Int -> a
UV.! (forall a. Enum a => a -> Int
fromEnum ErrorLevel
e forall a. Num a => a -> a -> a
* Int
40 forall a. Num a => a -> a -> a
+ Version -> Int
unVersion Version
v forall a. Num a => a -> a -> a
- Int
1)

numErrorCorrectionBlocksData :: UV.Vector Int
{-# NOINLINE numErrorCorrectionBlocksData #-}
numErrorCorrectionBlocksData :: Vector Int
numErrorCorrectionBlocksData =
  [ --1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40      Error correction level
      Int
1, Int
1, Int
1, Int
1, Int
1, Int
2, Int
2, Int
2, Int
2,  Int
4,  Int
4,  Int
4,  Int
4,  Int
4,  Int
6,  Int
6,  Int
6,  Int
6,  Int
7,  Int
8,  Int
8,  Int
9,  Int
9, Int
10, Int
12, Int
12, Int
12, Int
13, Int
14, Int
15, Int
16, Int
17, Int
18, Int
19, Int
19, Int
20, Int
21, Int
22, Int
24, Int
25,  -- Low
      Int
1, Int
1, Int
1, Int
2, Int
2, Int
4, Int
4, Int
4, Int
5,  Int
5,  Int
5,  Int
8,  Int
9,  Int
9, Int
10, Int
10, Int
11, Int
13, Int
14, Int
16, Int
17, Int
17, Int
18, Int
20, Int
21, Int
23, Int
25, Int
26, Int
28, Int
29, Int
31, Int
33, Int
35, Int
37, Int
38, Int
40, Int
43, Int
45, Int
47, Int
49,  -- Medium
      Int
1, Int
1, Int
2, Int
2, Int
4, Int
4, Int
6, Int
6, Int
8,  Int
8,  Int
8, Int
10, Int
12, Int
16, Int
12, Int
17, Int
16, Int
18, Int
21, Int
20, Int
23, Int
23, Int
25, Int
27, Int
29, Int
34, Int
34, Int
35, Int
38, Int
40, Int
43, Int
45, Int
48, Int
51, Int
53, Int
56, Int
59, Int
62, Int
65, Int
68,  -- Quartile
      Int
1, Int
1, Int
2, Int
4, Int
4, Int
4, Int
5, Int
6, Int
8,  Int
8, Int
11, Int
11, Int
16, Int
16, Int
18, Int
16, Int
19, Int
21, Int
25, Int
25, Int
25, Int
34, Int
30, Int
32, Int
35, Int
37, Int
40, Int
42, Int
45, Int
48, Int
51, Int
54, Int
57, Int
60, Int
63, Int
66, Int
70, Int
74, Int
77, Int
81   -- High
  ]