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 QR_ECLEVEL_L = 0
convertQREncodeLevel QR_ECLEVEL_M = 1
convertQREncodeLevel QR_ECLEVEL_Q = 2
convertQREncodeLevel QR_ECLEVEL_H = 3
convertQREncodeMode :: QREncodeMode -> CInt
convertQREncodeMode QR_MODE_NUM = 0
convertQREncodeMode QR_MODE_AN = 1
convertQREncodeMode QR_MODE_EIGHT = 2
convertQREncodeMode QR_MODE_KANJI = 3
data QRcode = QRcode {
getQRCodeVersion :: Int,
getQRCodeWidth :: Int,
getQRCodeString :: ByteString
} deriving (Show, Read)
data QRcodeStruct = QRcodeStruct {
c_version :: CInt,
c_width :: CInt,
c_data :: CString
} deriving (Show)
instance Storable QRcodeStruct where
alignment _ = 4
sizeOf _ = (12)
peek ptr = do
version <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
width <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
data' <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
return $ QRcodeStruct version width data'
poke ptr (QRcodeStruct version width data') = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr version
(\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr width
(\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr data'
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 str version level mode casesensitive = do
when (BS.null str) $ error "empty bytestring provided"
useAsCString str $ \s-> encoder s version level mode casesensitive
encodeString :: String
-> Maybe Int
-> QREncodeLevel
-> QREncodeMode
-> Bool
-> IO QRcode
encodeString str version level mode casesensitive = do
when (null str) $ error "empty string provided"
newCAString str >>= \s-> encoder s version level mode casesensitive
encoder :: CString -> Maybe Int -> QREncodeLevel -> QREncodeMode -> Bool -> IO QRcode
encoder cstr ver level mode casesensitive = do
let l = convertQREncodeLevel level
let m = convertQREncodeMode mode
c_qrptr <- throwErrnoIfNull "haskell-qrencode/QRcode_encodeString" $
c_encodeString cstr (fromIntegral $ fromMaybe 0 ver) l m (b2i casesensitive)
c_qr <- peek c_qrptr
let version = fromIntegral (c_version c_qr)
let width = fromIntegral (c_width c_qr)
str <- packCStringLen (c_data c_qr, width * width)
c_free c_qrptr
return (QRcode version width str)
where
b2i True = 1
b2i False = 0
toMatrix :: QRcode -> [[Word8]]
toMatrix (QRcode _ width str) =
regroup . map tobin . unpack $ str
where
tobin c = c .&. 1
regroup [] = []
regroup xs = let ~(this, rest) = splitAt width xs
in this : regroup rest