{-# LANGUAGE OverloadedStrings #-}

module Text.LaTeX.Packages.QRCode
 ( -- * qrcode package
   qrcode
   -- * qrcode commands
 , ErrorLevel(..)
 , CodeOptions(..)
 , defaultOptions
 , qr
   -- * Package Options
 , draft
 , final
   ) where

import Text.LaTeX.Base.Syntax
import Text.LaTeX.Base.Class
import Text.LaTeX.Base.Render
import Text.LaTeX.Base.Types
import Text.LaTeX.Base.Texy
import qualified Data.Text as T

-- | qrcode package. Use it to import it like this:
--
-- > usepackage [] qrcode
qrcode :: PackageName
qrcode :: PackageName
qrcode = PackageName
"qrcode"

-- | The degree of error-correction redundancy to
-- include in the generated code.
data ErrorLevel = Low -- ^ Error recovery up to 7%.
                | Medium -- ^ Error recovery up to 15%.
                | Quality -- ^ Error recovery up to 25%.
                | High -- ^ Error recovery up to 30%.
  deriving (ErrorLevel -> ErrorLevel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorLevel -> ErrorLevel -> Bool
$c/= :: ErrorLevel -> ErrorLevel -> Bool
== :: ErrorLevel -> ErrorLevel -> Bool
$c== :: ErrorLevel -> ErrorLevel -> Bool
Eq, Eq ErrorLevel
ErrorLevel -> ErrorLevel -> Bool
ErrorLevel -> ErrorLevel -> Ordering
ErrorLevel -> ErrorLevel -> ErrorLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ErrorLevel -> ErrorLevel -> ErrorLevel
$cmin :: ErrorLevel -> ErrorLevel -> ErrorLevel
max :: ErrorLevel -> ErrorLevel -> ErrorLevel
$cmax :: ErrorLevel -> ErrorLevel -> ErrorLevel
>= :: ErrorLevel -> ErrorLevel -> Bool
$c>= :: ErrorLevel -> ErrorLevel -> Bool
> :: ErrorLevel -> ErrorLevel -> Bool
$c> :: ErrorLevel -> ErrorLevel -> Bool
<= :: ErrorLevel -> ErrorLevel -> Bool
$c<= :: ErrorLevel -> ErrorLevel -> Bool
< :: ErrorLevel -> ErrorLevel -> Bool
$c< :: ErrorLevel -> ErrorLevel -> Bool
compare :: ErrorLevel -> ErrorLevel -> Ordering
$ccompare :: ErrorLevel -> ErrorLevel -> Ordering
Ord, ReadPrec [ErrorLevel]
ReadPrec ErrorLevel
Int -> ReadS ErrorLevel
ReadS [ErrorLevel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ErrorLevel]
$creadListPrec :: ReadPrec [ErrorLevel]
readPrec :: ReadPrec ErrorLevel
$creadPrec :: ReadPrec ErrorLevel
readList :: ReadS [ErrorLevel]
$creadList :: ReadS [ErrorLevel]
readsPrec :: Int -> ReadS ErrorLevel
$creadsPrec :: Int -> ReadS ErrorLevel
Read, Int -> ErrorLevel -> ShowS
[ErrorLevel] -> ShowS
ErrorLevel -> PackageName
forall a.
(Int -> a -> ShowS)
-> (a -> PackageName) -> ([a] -> ShowS) -> Show a
showList :: [ErrorLevel] -> ShowS
$cshowList :: [ErrorLevel] -> ShowS
show :: ErrorLevel -> PackageName
$cshow :: ErrorLevel -> PackageName
showsPrec :: Int -> ErrorLevel -> ShowS
$cshowsPrec :: Int -> ErrorLevel -> ShowS
Show)

-- | Options to use when generating a QR code.
data CodeOptions = CodeOptions {
                  CodeOptions -> Bool
includePadding :: Bool -- ^ Whether to include 4 modules of whitespace around the code. False is the default.
                , CodeOptions -> Bool
link :: Bool -- ^ Whether, if the code encodes a link, it should be hyperlinked in the PDF document. The default is true. Links will only be generated when the document uses the hyperref package.
                , CodeOptions -> ErrorLevel
errorLevel :: ErrorLevel -- ^ The desired degree of error-correction redundancy to include in the code. The default is 'Medium'.
                }
  deriving (CodeOptions -> CodeOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CodeOptions -> CodeOptions -> Bool
$c/= :: CodeOptions -> CodeOptions -> Bool
== :: CodeOptions -> CodeOptions -> Bool
$c== :: CodeOptions -> CodeOptions -> Bool
Eq, Int -> CodeOptions -> ShowS
[CodeOptions] -> ShowS
CodeOptions -> PackageName
forall a.
(Int -> a -> ShowS)
-> (a -> PackageName) -> ([a] -> ShowS) -> Show a
showList :: [CodeOptions] -> ShowS
$cshowList :: [CodeOptions] -> ShowS
show :: CodeOptions -> PackageName
$cshow :: CodeOptions -> PackageName
showsPrec :: Int -> CodeOptions -> ShowS
$cshowsPrec :: Int -> CodeOptions -> ShowS
Show)



-- | The default QR code generation options.
defaultOptions :: CodeOptions
defaultOptions :: CodeOptions
defaultOptions = CodeOptions { includePadding :: Bool
includePadding = Bool
False, link :: Bool
link = Bool
True, errorLevel :: ErrorLevel
errorLevel = ErrorLevel
Medium }

-- | This package option sets the qrcode package to generate draft-quality placeholders for QR codes.
draft :: LaTeXC l => l
draft :: forall l. LaTeXC l => l
draft = l
"draft"

-- | This package option (which is the default) sets the qrcode package to generate print-quality QR codes.
final :: LaTeXC l => l
final :: forall l. LaTeXC l => l
final = l
"final"

-- | Generates a QR code with specified options and content.
--
-- This uses the \qrcode command from the package, but the identifier
-- 'qrcode' is already in use as the 'PackageName'.
qr :: LaTeXC l => CodeOptions -> Text -> l
qr :: forall l. LaTeXC l => CodeOptions -> Text -> l
qr CodeOptions
opt Text
payload = forall l. LaTeXC l => LaTeX -> l
fromLaTeX forall a b. (a -> b) -> a -> b
$ PackageName -> [TeXArg] -> LaTeX
TeXComm PackageName
"qrcode" [TeXArg
opts, LaTeX -> TeXArg
FixArg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. LaTeXC l => Text -> l
raw forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
escape forall a b. (a -> b) -> a -> b
$ Text
payload]
  where
    opts :: TeXArg
opts = [LaTeX] -> TeXArg
MOptArg [ if CodeOptions -> Bool
includePadding CodeOptions
opt then LaTeX
"padding" else LaTeX
"tight"
                   , if CodeOptions -> Bool
link CodeOptions
opt then LaTeX
"link" else LaTeX
"nolink"
                   , forall t l. (Texy t, LaTeXC l) => t -> l
texy forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"level=" forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> PackageName
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeOptions -> ErrorLevel
errorLevel forall a b. (a -> b) -> a -> b
$ CodeOptions
opt
                   ]

-- Helper functions for escaping code contents.
escape :: Text -> Text
escape :: Text -> Text
escape = (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
handleChar
  where handleChar :: Char -> Text
handleChar Char
c | Char -> Bool
isSpecial Char
c = PackageName -> Text
T.pack [Char
'\\', Char
c]
                     | Bool
otherwise   = Char -> Text
T.singleton Char
c

isSpecial :: Char -> Bool
isSpecial :: Char -> Bool
isSpecial Char
c = Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (PackageName
"#$&^_~% \\{}" :: String)