{-# LANGUAGE NoImplicitPrelude #-}

module Codec.QRCode.Code.Intermediate
  ( toIntermediate
  , fromIntermediate
  ) where

import           Codec.QRCode.Base

import           Codec.QRCode.Code.Data
import           Codec.QRCode.Code.Image
import           Codec.QRCode.Code.Mask
import qualified Codec.QRCode.Data.ByteStreamBuilder       as BSB
import           Codec.QRCode.Data.Mask
import qualified Codec.QRCode.Data.MQRImage                as MI
import           Codec.QRCode.Data.QRCodeOptions
import           Codec.QRCode.Data.QRImage
import           Codec.QRCode.Data.QRIntermediate.Internal
import           Codec.QRCode.Data.QRSegment.Internal
import           Codec.QRCode.Data.Result

-- | Convert segments into an intermediate state.
--   This is the first point where it can be guaranteed that there will
--   be an result. The Version and ErrorLevel is already determined at
--   this point.
toIntermediate :: QRCodeOptions -> QRSegment -> Result QRIntermediate
{-# INLINE toIntermediate #-}
toIntermediate :: QRCodeOptions -> QRSegment -> Result QRIntermediate
toIntermediate = QRCodeOptions -> QRSegment -> Result QRIntermediate
calcVersionAndErrorLevel

-- | Convert the intermediate state into an image.
fromIntermediate :: QRIntermediate -> QRImage
{-# INLINE fromIntermediate #-}
fromIntermediate :: QRIntermediate -> QRImage
fromIntermediate = QRInternal [Word8] -> QRImage
generateQRImage (QRInternal [Word8] -> QRImage)
-> (QRIntermediate -> QRInternal [Word8])
-> QRIntermediate
-> QRImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QRInternal ByteStreamBuilder -> QRInternal [Word8]
appendErrorCorrection (QRInternal ByteStreamBuilder -> QRInternal [Word8])
-> (QRIntermediate -> QRInternal ByteStreamBuilder)
-> QRIntermediate
-> QRInternal [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QRIntermediate -> QRInternal ByteStreamBuilder
appendEndAndPadding

-- | "Draw" the image
generateQRImage :: QRInternal [Word8] -> QRImage
generateQRImage :: QRInternal [Word8] -> QRImage
generateQRImage (Version
v, ErrorLevel
e, [Word8]
bs, Maybe Mask
mmask) = (forall s. ST s QRImage) -> QRImage
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s QRImage) -> QRImage)
-> (forall s. ST s QRImage) -> QRImage
forall a b. (a -> b) -> a -> b
$ do
  -- create a new image
  MQRImage1 s
img1 <- Version -> ErrorLevel -> ST s (MQRImage1 (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Version -> ErrorLevel -> m (MQRImage1 (PrimState m))
MI.new Version
v ErrorLevel
e
  -- draw all function modules
  MQRImage1 (PrimState (ST s)) -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> m ()
drawFunctionPatterns MQRImage1 s
MQRImage1 (PrimState (ST s))
img1
  -- convert the image, now the information wether an module is for data or function can't be changed anymore
  MQRImage2 s
img2 <- MQRImage1 (PrimState (ST s)) -> ST s (MQRImage2 (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
MQRImage1 (PrimState m) -> m (MQRImage2 (PrimState m))
MI.unsafeConvert MQRImage1 s
MQRImage1 (PrimState (ST s))
img1
  -- draw the image
  MQRImage2 (PrimState (ST s)) -> [Bool] -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MQRImage2 (PrimState m) -> [Bool] -> m ()
drawCodeWords MQRImage2 s
MQRImage2 (PrimState (ST s))
img2 ([Word8] -> [Bool]
BSB.toBitStream [Word8]
bs)
  case Maybe Mask
mmask of
    Just Mask
m -> do
      -- a specific mask was given
      -- clone the current image
      MQRImage3 s
img3 <- MQRImage2 (PrimState (ST s)) -> ST s (MQRImage3 (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
MQRImage2 (PrimState m) -> m (MQRImage3 (PrimState m))
MI.clone MQRImage2 s
MQRImage2 (PrimState (ST s))
img2
      -- apply the mask
      MQRImage3 (PrimState (ST s)) -> Mask -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MQRImage3 (PrimState m) -> Mask -> m ()
applyMask MQRImage3 s
MQRImage3 (PrimState (ST s))
img3 Mask
m
      -- return the image
      MQRImage3 (PrimState (ST s)) -> ST s QRImage
forall (m :: * -> *).
PrimMonad m =>
MQRImage3 (PrimState m) -> m QRImage
MI.unsafeFreeze MQRImage3 s
MQRImage3 (PrimState (ST s))
img3
    Maybe Mask
Nothing -> do
      [(Int, QRImage)]
rs <- [Mask] -> (Mask -> ST s (Int, QRImage)) -> ST s [(Int, QRImage)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Mask
Mask0 .. Mask
Mask7] ((Mask -> ST s (Int, QRImage)) -> ST s [(Int, QRImage)])
-> (Mask -> ST s (Int, QRImage)) -> ST s [(Int, QRImage)]
forall a b. (a -> b) -> a -> b
$ \Mask
m -> do
        -- create a new clone of the image
        MQRImage3 s
img3 <- MQRImage2 (PrimState (ST s)) -> ST s (MQRImage3 (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
MQRImage2 (PrimState m) -> m (MQRImage3 (PrimState m))
MI.clone MQRImage2 s
MQRImage2 (PrimState (ST s))
img2
        -- apply the mask
        MQRImage3 (PrimState (ST s)) -> Mask -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MQRImage3 (PrimState m) -> Mask -> m ()
applyMask MQRImage3 s
MQRImage3 (PrimState (ST s))
img3 Mask
m
        -- freeze the image (can't be altered anymore)
        QRImage
qrimg <- MQRImage3 (PrimState (ST s)) -> ST s QRImage
forall (m :: * -> *).
PrimMonad m =>
MQRImage3 (PrimState m) -> m QRImage
MI.unsafeFreeze MQRImage3 s
MQRImage3 (PrimState (ST s))
img3
        -- return the image along with the penalty score
        (Int, QRImage) -> ST s (Int, QRImage)
forall (m :: * -> *) a. Monad m => a -> m a
return (QRImage -> Int
getPenaltyScore QRImage
qrimg, QRImage
qrimg)
      -- pick the image with the lowest penalty score
      QRImage -> ST s QRImage
forall (m :: * -> *) a. Monad m => a -> m a
return (QRImage -> ST s QRImage) -> QRImage -> ST s QRImage
forall a b. (a -> b) -> a -> b
$ (Int, QRImage) -> QRImage
forall a b. (a, b) -> b
snd ((Int, QRImage) -> QRImage) -> (Int, QRImage) -> QRImage
forall a b. (a -> b) -> a -> b
$ [(Int, QRImage)] -> (Int, QRImage)
forall a. [a] -> a
head ([(Int, QRImage)] -> (Int, QRImage))
-> [(Int, QRImage)] -> (Int, QRImage)
forall a b. (a -> b) -> a -> b
$ ((Int, QRImage) -> Int) -> [(Int, QRImage)] -> [(Int, QRImage)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Int, QRImage) -> Int
forall a b. (a, b) -> a
fst [(Int, QRImage)]
rs