{-# LANGUAGE NoImplicitPrelude #-}

module Codec.QRCode.Data.QRCodeOptions
  ( QRCodeOptions(..)
  , defaultQRCodeOptions
  ) where

import           Codec.QRCode.Base

import           Codec.QRCode.Data.ErrorLevel
import           Codec.QRCode.Data.Mask

data QRCodeOptions
  = QRCodeOptions
    { QRCodeOptions -> Int
qroMinVersion      :: !Int          -- ^ Minimal version (i.e. size) the qr code may have
    , QRCodeOptions -> Int
qroMaxVersion      :: !Int          -- ^ Maximal version (i.e. size) the qr code may have
    , QRCodeOptions -> ErrorLevel
qroErrorLevel      :: !ErrorLevel   -- ^ Selected error correction level
    , QRCodeOptions -> Bool
qroBoostErrorLevel :: !Bool         -- ^ Increase error correction level within the same version if possible
    , QRCodeOptions -> Maybe Mask
qroMask            :: !(Maybe Mask) -- ^ Specify a mask to be used, only use it if you know what you're doing
    }

-- | The default options are all versions, boost error level and automatic mask, the error level has always to be specified
defaultQRCodeOptions :: ErrorLevel -> QRCodeOptions
defaultQRCodeOptions :: ErrorLevel -> QRCodeOptions
defaultQRCodeOptions ErrorLevel
e =
  Int -> Int -> ErrorLevel -> Bool -> Maybe Mask -> QRCodeOptions
QRCodeOptions Int
1 Int
40 ErrorLevel
e Bool
True Maybe Mask
forall a. Maybe a
Nothing