{-# LANGUAGE NoImplicitPrelude #-}
module Codec.QRCode.Code.ReedSolomonEncoder
( RsGeneratorPolynomial
, rsGeneratorPolynomial
, rsEncode
) where
import Codec.QRCode.Base
import qualified Data.Vector.Unboxed as UV
import qualified Data.Vector.Unboxed.Mutable as MUV
newtype RsGeneratorPolynomial
= RsGeneratorPolynomial (UV.Vector Word8)
rsGeneratorPolynomial :: Int -> RsGeneratorPolynomial
rsGeneratorPolynomial degree = runST $ do
coefficients <- MUV.new degree
MUV.set coefficients 0
MUV.write coefficients (degree-1) 1
void $ iterateNM degree 1 $ \root -> do
forM_ [0 .. degree-2] $ \j -> do
next <- MUV.read coefficients (j+1)
MUV.modify coefficients (\c -> multiply c root `xor` next) j
MUV.modify coefficients (multiply root) (degree-1)
return (multiply root 0x02)
RsGeneratorPolynomial <$> UV.unsafeFreeze coefficients
where
iterateNM :: Monad m => Int -> a -> (a -> m a) -> m a
iterateNM n0 i0 f = go n0 i0
where
go n i
| n <= 0 = return i
| otherwise = go (n-1) =<< f i
rsEncode :: RsGeneratorPolynomial -> [Word8] -> [Word8]
rsEncode (RsGeneratorPolynomial coefficients) input = runST $ do
let
len = UV.length coefficients
result <- MUV.new len
MUV.set result 0
forM_ input $ \b -> do
r0 <- MUV.read result 0
let
factor = b `xor` r0
forM_ [1 .. len-1] $ \i -> do
t <- MUV.read result i
MUV.write result (i-1) t
MUV.write result (len-1) 0
forM_ [0 .. len-1] $ \i ->
MUV.modify result (\rx -> rx `xor` multiply (coefficients UV.! i) factor) i
result' <- UV.unsafeFreeze result
return (UV.toList result')
multiply :: Word8 -> Word8 -> Word8
{-# INLINABLE multiply #-}
multiply x y =
let
step z i =
(z `shiftL` 1) `xor` ((z `shiftR` 7) * 0x1d)
`xor` (((y `shiftR` i) .&. 1) * x)
in
foldl' step 0 [7, 6 .. 0]