{-# 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
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
type QRInternal t = (Version, ErrorLevel, t, Maybe Mask)
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 =
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
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
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
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
errorLevels :: [ErrorLevel]
errorLevels :: [ErrorLevel]
errorLevels
| Bool
qroBoostErrorLevel = [ErrorLevel
H, ErrorLevel
Q .. ErrorLevel
qroErrorLevel]
| Bool
otherwise = [ErrorLevel
qroErrorLevel]
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
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))
appendEndAndPadding :: QRIntermediate -> QRInternal BSB.ByteStreamBuilder
appendEndAndPadding :: QRIntermediate -> QRInternal ByteStreamBuilder
appendEndAndPadding (QRIntermediate Version
v ErrorLevel
e Int
bsl ByteStreamBuilder
bs Maybe Mask
mmask) =
let
capacity :: Int
capacity = Int
8 forall a. Num a => a -> a -> a
* Version -> ErrorLevel -> Int
numDataCodeWords Version
v ErrorLevel
e
endLen :: Int
endLen = Int
4 forall a. Ord a => a -> a -> a
`min` (Int
capacity forall a. Num a => a -> a -> a
- Int
bsl)
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
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)
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)
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
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
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
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
in
Int
size forall a. Num a => a -> a -> a
* Int
size
forall a. Num a => a -> a -> a
- Int
64 forall a. Num a => a -> a -> a
* Int
3
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)
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
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 =
[
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,
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,
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,
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
]
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 =
[
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,
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,
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,
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
]