{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Codec.QRCode.JuicyPixels
  ( -- * Image
    toImage
    -- * URL
  , toPngDataUrlBS
  , toPngDataUrlS
  , toPngDataUrlT
  ) where

import           Codec.Picture               (Image (..), Pixel8, encodePng)
import           Data.Bool                   (bool)
import qualified Data.ByteString.Base64.Lazy as B64L
import qualified Data.ByteString.Lazy        as BL
import qualified Data.ByteString.Lazy.Char8  as BLC8
import qualified Data.Text.Lazy              as TL
import qualified Data.Vector.Storable        as SV
import qualified Data.Vector.Unboxed         as UV
import           Data.Word                   (Word8)

import           Codec.QRCode                (QRImage (..))

-- | Convert the QR code into an image.
--
--   If this is not the required image format use `Codec.Picture.Types.promoteImage` and/or `Codec.Picture.Types.convertImage`.
toImage
  :: Int -- ^ Border to add around the QR code, recommended is 4 (<0 is treated as 0)
  -> Int -- ^ Factor to scale the image (<1 is treated as 1)
  -> QRImage -- ^ The QRImage
  -> Image Pixel8
toImage :: Int -> Int -> QRImage -> Image Pixel8
toImage Int
border Int
scale QRImage{Int
ErrorLevel
Vector Bool
qrVersion :: QRImage -> Int
qrErrorLevel :: QRImage -> ErrorLevel
qrImageSize :: QRImage -> Int
qrImageData :: QRImage -> Vector Bool
qrImageData :: Vector Bool
qrImageSize :: Int
qrErrorLevel :: ErrorLevel
qrVersion :: Int
..}
  | Int
border Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 Bool -> Bool -> Bool
&& Int
scale Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 =
    Int -> Int -> Vector (PixelBaseComponent Pixel8) -> Image Pixel8
forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
Image Int
qrImageSize Int
qrImageSize ([Pixel8] -> Vector Pixel8
forall a. Storable a => [a] -> Vector a
SV.fromList ([Pixel8] -> Vector Pixel8) -> [Pixel8] -> Vector Pixel8
forall a b. (a -> b) -> a -> b
$ (Bool -> Pixel8) -> [Bool] -> [Pixel8]
forall a b. (a -> b) -> [a] -> [b]
map (Pixel8 -> Pixel8 -> Bool -> Pixel8
forall a. a -> a -> Bool -> a
bool Pixel8
0xff Pixel8
0x00) (Vector Bool -> [Bool]
forall a. Unbox a => Vector a -> [a]
UV.toList Vector Bool
qrImageData))
toImage Int
border' Int
scale' QRImage{Int
ErrorLevel
Vector Bool
qrImageData :: Vector Bool
qrImageSize :: Int
qrErrorLevel :: ErrorLevel
qrVersion :: Int
qrVersion :: QRImage -> Int
qrErrorLevel :: QRImage -> ErrorLevel
qrImageSize :: QRImage -> Int
qrImageData :: QRImage -> Vector Bool
..} =
  let
    border :: Int
border = Int
border' Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
0
    scale :: Int
scale = Int
scale' Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
1
    size :: Int
size = (Int
qrImageSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
border) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
scale
  in
    Int -> Int -> Vector (PixelBaseComponent Pixel8) -> Image Pixel8
forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
Image Int
size Int
size ([Pixel8] -> Vector Pixel8
forall a. Storable a => [a] -> Vector a
SV.fromList ([Pixel8] -> Vector Pixel8) -> [Pixel8] -> Vector Pixel8
forall a b. (a -> b) -> a -> b
$ [[Pixel8]] -> [Pixel8]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Pixel8]] -> [Pixel8]) -> [[Pixel8]] -> [Pixel8]
forall a b. (a -> b) -> a -> b
$ Int -> [[Pixel8]] -> [[Pixel8]]
doScale Int
scale ([[Pixel8]] -> [[Pixel8]]) -> [[Pixel8]] -> [[Pixel8]]
forall a b. (a -> b) -> a -> b
$ Int -> [[Pixel8]] -> [[Pixel8]]
addBorder Int
border ([[Pixel8]] -> [[Pixel8]]) -> [[Pixel8]] -> [[Pixel8]]
forall a b. (a -> b) -> a -> b
$ Vector Bool -> [[Pixel8]]
toMatrix Vector Bool
qrImageData)
  where
    toMatrix :: UV.Vector Bool -> [[Word8]]
    toMatrix :: Vector Bool -> [[Pixel8]]
toMatrix Vector Bool
img
      | Vector Bool -> Bool
forall a. Unbox a => Vector a -> Bool
UV.null Vector Bool
img = []
      | Bool
otherwise =
        let
          (Vector Bool
h, Vector Bool
t) = Int -> Vector Bool -> (Vector Bool, Vector Bool)
forall a. Unbox a => Int -> Vector a -> (Vector a, Vector a)
UV.splitAt Int
qrImageSize Vector Bool
img
        in
          (Bool -> Pixel8) -> [Bool] -> [Pixel8]
forall a b. (a -> b) -> [a] -> [b]
map (Pixel8 -> Pixel8 -> Bool -> Pixel8
forall a. a -> a -> Bool -> a
bool Pixel8
0xff Pixel8
0x00) (Vector Bool -> [Bool]
forall a. Unbox a => Vector a -> [a]
UV.toList Vector Bool
h) [Pixel8] -> [[Pixel8]] -> [[Pixel8]]
forall a. a -> [a] -> [a]
: Vector Bool -> [[Pixel8]]
toMatrix Vector Bool
t
    addBorder :: Int -> [[Word8]] -> [[Word8]]
    addBorder :: Int -> [[Pixel8]] -> [[Pixel8]]
addBorder Int
0 [[Pixel8]]
img = [[Pixel8]]
img
    addBorder Int
n [[Pixel8]]
img = [[Pixel8]]
topBottom [[Pixel8]] -> [[Pixel8]] -> [[Pixel8]]
forall a. [a] -> [a] -> [a]
++ [[Pixel8]] -> [[Pixel8]]
addLeftRight [[Pixel8]]
img [[Pixel8]] -> [[Pixel8]] -> [[Pixel8]]
forall a. [a] -> [a] -> [a]
++ [[Pixel8]]
topBottom
      where
        topBottom :: [[Pixel8]]
topBottom = [Int -> Pixel8 -> [Pixel8]
forall a. Int -> a -> [a]
replicate ((Int
qrImageSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n) Pixel8
0xff]
        leftRight :: [Pixel8]
leftRight = Int -> Pixel8 -> [Pixel8]
forall a. Int -> a -> [a]
replicate Int
n Pixel8
0xff
        addLeftRight :: [[Pixel8]] -> [[Pixel8]]
addLeftRight = ([Pixel8] -> [Pixel8]) -> [[Pixel8]] -> [[Pixel8]]
forall a b. (a -> b) -> [a] -> [b]
map (\ [Pixel8]
x -> [Pixel8]
leftRight [Pixel8] -> [Pixel8] -> [Pixel8]
forall a. [a] -> [a] -> [a]
++ [Pixel8]
x [Pixel8] -> [Pixel8] -> [Pixel8]
forall a. [a] -> [a] -> [a]
++ [Pixel8]
leftRight)
    doScale :: Int -> [[Word8]] -> [[Word8]]
    doScale :: Int -> [[Pixel8]] -> [[Pixel8]]
doScale Int
1 [[Pixel8]]
img = [[Pixel8]]
img
    doScale Int
n [[Pixel8]]
img = [[Pixel8]] -> [[Pixel8]]
scaleV [[Pixel8]]
img
      where
        scaleV :: [[Word8]] -> [[Word8]]
        scaleV :: [[Pixel8]] -> [[Pixel8]]
scaleV = ([Pixel8] -> [[Pixel8]]) -> [[Pixel8]] -> [[Pixel8]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> [Pixel8] -> [[Pixel8]]
forall a. Int -> a -> [a]
replicate Int
n ([Pixel8] -> [[Pixel8]])
-> ([Pixel8] -> [Pixel8]) -> [Pixel8] -> [[Pixel8]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pixel8] -> [Pixel8]
scaleH)
        scaleH :: [Word8] -> [Word8]
        scaleH :: [Pixel8] -> [Pixel8]
scaleH = (Pixel8 -> [Pixel8]) -> [Pixel8] -> [Pixel8]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> Pixel8 -> [Pixel8]
forall a. Int -> a -> [a]
replicate Int
n)

-- | Convert an QR code into a Uri.
--   Has the same arguments as `toImage`.
--
--   This can be used to display a image in HTML without creating a temporary file.
toPngDataUrlBS :: Int -> Int -> QRImage -> BL.ByteString
toPngDataUrlBS :: Int -> Int -> QRImage -> ByteString
toPngDataUrlBS Int
border Int
scale QRImage
img = ByteString
"data:image/png;base64," ByteString -> ByteString -> ByteString
`BL.append` ByteString -> ByteString
B64L.encode (Image Pixel8 -> ByteString
forall a. PngSavable a => Image a -> ByteString
encodePng (Image Pixel8 -> ByteString) -> Image Pixel8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Int -> QRImage -> Image Pixel8
toImage Int
border Int
scale QRImage
img)

-- | Convert an QR code into a Uri.
--   Has the same arguments as `toImage`.
--
--   Like `toPngDataUrlBS` but with a to String conversion afterwards.
toPngDataUrlS :: Int -> Int -> QRImage -> String
{-# INLINE toPngDataUrlS #-}
toPngDataUrlS :: Int -> Int -> QRImage -> String
toPngDataUrlS Int
border Int
scale = ByteString -> String
BLC8.unpack (ByteString -> String)
-> (QRImage -> ByteString) -> QRImage -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> QRImage -> ByteString
toPngDataUrlBS Int
border Int
scale

-- | Convert an QR code into a Uri.
--   Has the same arguments as `toImage`.
--
--   Like `toPngDataUrlS` but with a to Text conversion afterwards.
toPngDataUrlT :: Int -> Int -> QRImage -> TL.Text
{-# INLINE toPngDataUrlT #-}
toPngDataUrlT :: Int -> Int -> QRImage -> Text
toPngDataUrlT Int
border Int
scale = String -> Text
TL.pack (String -> Text) -> (QRImage -> String) -> QRImage -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> QRImage -> String
toPngDataUrlS Int
border Int
scale