{-# LINE 1 "src/Data/QRCode.hsc" #-}
{-# LANGUAGE CPP, ForeignFunctionInterface #-}
module Data.QRCode (encodeByteString,
encodeString,
getQRCodeVersion,
getQRCodeWidth,
getQRCodeString,
toMatrix,
QREncodeLevel (..),
QREncodeMode (..)) where
import Control.Monad
import Data.ByteString (ByteString, unpack, useAsCString, packCStringLen)
import qualified Data.ByteString as BS
import Data.Maybe
import Foreign
import Foreign.C.Error
import Foreign.C.String
import Foreign.C.Types
import Foreign.Storable
data QREncodeLevel = QR_ECLEVEL_L
| QR_ECLEVEL_M
| QR_ECLEVEL_Q
| QR_ECLEVEL_H
data QREncodeMode = QR_MODE_NUM
| QR_MODE_AN
| QR_MODE_EIGHT
| QR_MODE_KANJI
convertQREncodeLevel :: QREncodeLevel -> CInt
convertQREncodeLevel :: QREncodeLevel -> CInt
convertQREncodeLevel QREncodeLevel
QR_ECLEVEL_L = CInt
0
{-# LINE 42 "src/Data/QRCode.hsc" #-}
convertQREncodeLevel QR_ECLEVEL_M = 1
{-# LINE 43 "src/Data/QRCode.hsc" #-}
convertQREncodeLevel QR_ECLEVEL_Q = 2
{-# LINE 44 "src/Data/QRCode.hsc" #-}
convertQREncodeLevel QR_ECLEVEL_H = 3
{-# LINE 45 "src/Data/QRCode.hsc" #-}
convertQREncodeMode :: QREncodeMode -> CInt
convertQREncodeMode :: QREncodeMode -> CInt
convertQREncodeMode QREncodeMode
QR_MODE_NUM = CInt
0
{-# LINE 48 "src/Data/QRCode.hsc" #-}
convertQREncodeMode QR_MODE_AN = 1
{-# LINE 49 "src/Data/QRCode.hsc" #-}
convertQREncodeMode QR_MODE_EIGHT = 2
{-# LINE 50 "src/Data/QRCode.hsc" #-}
convertQREncodeMode QR_MODE_KANJI = 3
{-# LINE 51 "src/Data/QRCode.hsc" #-}
data QRcode = QRcode {
QRcode -> Int
getQRCodeVersion :: Int,
QRcode -> Int
getQRCodeWidth :: Int,
QRcode -> ByteString
getQRCodeString :: ByteString
} deriving (Int -> QRcode -> ShowS
[QRcode] -> ShowS
QRcode -> String
(Int -> QRcode -> ShowS)
-> (QRcode -> String) -> ([QRcode] -> ShowS) -> Show QRcode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QRcode] -> ShowS
$cshowList :: [QRcode] -> ShowS
show :: QRcode -> String
$cshow :: QRcode -> String
showsPrec :: Int -> QRcode -> ShowS
$cshowsPrec :: Int -> QRcode -> ShowS
Show, ReadPrec [QRcode]
ReadPrec QRcode
Int -> ReadS QRcode
ReadS [QRcode]
(Int -> ReadS QRcode)
-> ReadS [QRcode]
-> ReadPrec QRcode
-> ReadPrec [QRcode]
-> Read QRcode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [QRcode]
$creadListPrec :: ReadPrec [QRcode]
readPrec :: ReadPrec QRcode
$creadPrec :: ReadPrec QRcode
readList :: ReadS [QRcode]
$creadList :: ReadS [QRcode]
readsPrec :: Int -> ReadS QRcode
$creadsPrec :: Int -> ReadS QRcode
Read)
data QRcodeStruct = QRcodeStruct {
QRcodeStruct -> CInt
c_version :: CInt,
QRcodeStruct -> CInt
c_width :: CInt,
QRcodeStruct -> CString
c_data :: CString
} deriving (Int -> QRcodeStruct -> ShowS
[QRcodeStruct] -> ShowS
QRcodeStruct -> String
(Int -> QRcodeStruct -> ShowS)
-> (QRcodeStruct -> String)
-> ([QRcodeStruct] -> ShowS)
-> Show QRcodeStruct
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QRcodeStruct] -> ShowS
$cshowList :: [QRcodeStruct] -> ShowS
show :: QRcodeStruct -> String
$cshow :: QRcodeStruct -> String
showsPrec :: Int -> QRcodeStruct -> ShowS
$cshowsPrec :: Int -> QRcodeStruct -> ShowS
Show)
instance Storable QRcodeStruct where
alignment :: QRcodeStruct -> Int
alignment QRcodeStruct
_ = Int
8
{-# LINE 69 "src/Data/QRCode.hsc" #-}
sizeOf :: QRcodeStruct -> Int
sizeOf QRcodeStruct
_ = (Int
16)
{-# LINE 71 "src/Data/QRCode.hsc" #-}
peek :: Ptr QRcodeStruct -> IO QRcodeStruct
peek Ptr QRcodeStruct
ptr = do
CInt
version <- (\Ptr QRcodeStruct
hsc_ptr -> Ptr QRcodeStruct -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr QRcodeStruct
hsc_ptr Int
0) Ptr QRcodeStruct
ptr
{-# LINE 74 "src/Data/QRCode.hsc" #-}
width <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
{-# LINE 75 "src/Data/QRCode.hsc" #-}
data' <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
{-# LINE 76 "src/Data/QRCode.hsc" #-}
return $ QRcodeStruct version width data'
poke :: Ptr QRcodeStruct -> QRcodeStruct -> IO ()
poke Ptr QRcodeStruct
ptr (QRcodeStruct CInt
version CInt
width CString
data') = do
(\Ptr QRcodeStruct
hsc_ptr -> Ptr QRcodeStruct -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr QRcodeStruct
hsc_ptr Int
0) Ptr QRcodeStruct
ptr CInt
version
{-# LINE 80 "src/Data/QRCode.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr width
{-# LINE 81 "src/Data/QRCode.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr data'
{-# LINE 82 "src/Data/QRCode.hsc" #-}
foreign import ccall safe "QRcode_encodeString"
c_encodeString :: CString
-> CInt
-> CInt
-> CInt
-> CInt
-> IO (Ptr QRcodeStruct)
foreign import ccall unsafe "QRcode_free"
c_free :: Ptr QRcodeStruct
-> IO ()
encodeByteString :: ByteString
-> Maybe Int
-> QREncodeLevel
-> QREncodeMode
-> Bool
-> IO QRcode
encodeByteString :: ByteString
-> Maybe Int -> QREncodeLevel -> QREncodeMode -> Bool -> IO QRcode
encodeByteString ByteString
str Maybe Int
version QREncodeLevel
level QREncodeMode
mode Bool
casesensitive = do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Bool
BS.null ByteString
str) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. HasCallStack => String -> a
error String
"empty bytestring provided"
ByteString -> (CString -> IO QRcode) -> IO QRcode
forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString ByteString
str ((CString -> IO QRcode) -> IO QRcode)
-> (CString -> IO QRcode) -> IO QRcode
forall a b. (a -> b) -> a -> b
$ \CString
s-> CString
-> Maybe Int -> QREncodeLevel -> QREncodeMode -> Bool -> IO QRcode
encoder CString
s Maybe Int
version QREncodeLevel
level QREncodeMode
mode Bool
casesensitive
encodeString :: String
-> Maybe Int
-> QREncodeLevel
-> QREncodeMode
-> Bool
-> IO QRcode
encodeString :: String
-> Maybe Int -> QREncodeLevel -> QREncodeMode -> Bool -> IO QRcode
encodeString String
str Maybe Int
version QREncodeLevel
level QREncodeMode
mode Bool
casesensitive = do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. HasCallStack => String -> a
error String
"empty string provided"
String -> IO CString
newCAString String
str IO CString -> (CString -> IO QRcode) -> IO QRcode
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CString
s-> CString
-> Maybe Int -> QREncodeLevel -> QREncodeMode -> Bool -> IO QRcode
encoder CString
s Maybe Int
version QREncodeLevel
level QREncodeMode
mode Bool
casesensitive
encoder :: CString -> Maybe Int -> QREncodeLevel -> QREncodeMode -> Bool -> IO QRcode
encoder :: CString
-> Maybe Int -> QREncodeLevel -> QREncodeMode -> Bool -> IO QRcode
encoder CString
cstr Maybe Int
ver QREncodeLevel
level QREncodeMode
mode Bool
casesensitive = do
let l :: CInt
l = QREncodeLevel -> CInt
convertQREncodeLevel QREncodeLevel
level
let m :: CInt
m = QREncodeMode -> CInt
convertQREncodeMode QREncodeMode
mode
Ptr QRcodeStruct
c_qrptr <- String -> IO (Ptr QRcodeStruct) -> IO (Ptr QRcodeStruct)
forall a. String -> IO (Ptr a) -> IO (Ptr a)
throwErrnoIfNull String
"haskell-qrencode/QRcode_encodeString" (IO (Ptr QRcodeStruct) -> IO (Ptr QRcodeStruct))
-> IO (Ptr QRcodeStruct) -> IO (Ptr QRcodeStruct)
forall a b. (a -> b) -> a -> b
$
CString -> CInt -> CInt -> CInt -> CInt -> IO (Ptr QRcodeStruct)
c_encodeString CString
cstr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
ver) CInt
l CInt
m (Bool -> CInt
forall {p}. Num p => Bool -> p
b2i Bool
casesensitive)
QRcodeStruct
c_qr <- Ptr QRcodeStruct -> IO QRcodeStruct
forall a. Storable a => Ptr a -> IO a
peek Ptr QRcodeStruct
c_qrptr
let version :: Int
version = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (QRcodeStruct -> CInt
c_version QRcodeStruct
c_qr)
let width :: Int
width = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (QRcodeStruct -> CInt
c_width QRcodeStruct
c_qr)
ByteString
str <- CStringLen -> IO ByteString
packCStringLen (QRcodeStruct -> CString
c_data QRcodeStruct
c_qr, Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width)
Ptr QRcodeStruct -> IO ()
c_free Ptr QRcodeStruct
c_qrptr
QRcode -> IO QRcode
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> ByteString -> QRcode
QRcode Int
version Int
width ByteString
str)
where
b2i :: Bool -> p
b2i Bool
True = p
1
b2i Bool
False = p
0
toMatrix :: QRcode -> [[Word8]]
toMatrix :: QRcode -> [[Word8]]
toMatrix (QRcode Int
_ Int
width ByteString
str) =
[Word8] -> [[Word8]]
forall {a}. [a] -> [[a]]
regroup ([Word8] -> [[Word8]])
-> (ByteString -> [Word8]) -> ByteString -> [[Word8]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8) -> [Word8] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Word8
forall {a}. (Bits a, Num a) => a -> a
tobin ([Word8] -> [Word8])
-> (ByteString -> [Word8]) -> ByteString -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
unpack (ByteString -> [[Word8]]) -> ByteString -> [[Word8]]
forall a b. (a -> b) -> a -> b
$ ByteString
str
where
tobin :: a -> a
tobin a
c = a
c a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
1
regroup :: [a] -> [[a]]
regroup [] = []
regroup [a]
xs = let ~([a]
this, [a]
rest) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
width [a]
xs
in [a]
this [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
regroup [a]
rest