packages feed

qrcode-core 0.8.0 → 0.9.0

raw patch · 19 files changed

+194/−115 lines, 19 files

Files

ChangeLog.md view
@@ -1,5 +1,15 @@ # Changelog for qrcode-core -## 0.8.0 -- 2019-01-xx+## 0.9.0 -- 2019-02-16++* Changed UTF-8 encoding: encoding a code point outside the unicode range will+  now fail the encoding, previously a replacement character was inserted+* Removed a, internal only, partial function+* Encoding empty data will result in an empty segment+* Encoding an empty segment fails+* Added functions to create an (non empty) segment without data+* Remove StrictData++## 0.8.0 -- 2019-01-09  * Initial release
qrcode-core.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 7edb42bfe998d381a298e87a2f5a671fa3ca2b93eac2bd1c149d877c048c59f2+-- hash: 57abfabcf9a41777287c8a5a350a210d519b6b6a7e87289f3d47dc4a4b05bd9b  name:           qrcode-core-version:        0.8.0+version:        0.9.0 synopsis:       QR code library in pure Haskell description:    Please see the README on GitHub at <https://github.com/alexkazik/qrcode/qrcode-core#readme> category:       codec@@ -32,6 +32,7 @@   exposed-modules:       Codec.QRCode       Codec.QRCode.Intermediate+      Codec.QRCode.Intermediate.Special       Codec.QRCode.Data.ErrorLevel       Codec.QRCode.Data.Mask       Codec.QRCode.Data.QRImage
src/Codec/QRCode/Code/Data.hs view
@@ -46,6 +46,7 @@         versions = versionsInRangeLimitedBy vr qroMinVersion qroMaxVersion       guard (not (null versions))       stream <- unQRSegment input vr+      guard (not (BSB.null stream))       firstSuccess (checkSize stream) versions     -- Check if the data fits into a specific `Version`.     checkSize :: BSB.ByteStreamBuilder -> Version -> Result QRIntermediate
src/Codec/QRCode/Data/ByteStreamBuilder.hs view
@@ -7,13 +7,16 @@   , encodeBits   , toList   , Codec.QRCode.Data.ByteStreamBuilder.length+  , Codec.QRCode.Data.ByteStreamBuilder.null   , fromList   , toBitStream   ) where  import           Codec.QRCode.Base +import           Data.Char         (intToDigit) import qualified Data.DList        as DL+import           Data.List         (intercalate)  -- | List of bits. Stored as a pair of Int, how many bits to store and the data, in a DList. --   The DList gives a O(1) append.@@ -51,6 +54,10 @@ {-# INLINEABLE length #-} length = sum . map fst . DL.toList . unBitStreamBuilder +null :: ByteStreamBuilder -> Bool+{-# INLINE null #-}+null = Codec.QRCode.Base.null . DL.toList . unBitStreamBuilder+ -- | Convert ByteStreamBuilder to list of Word8 toList :: ByteStreamBuilder -> [Word8] toList = go 0 0 . DL.toList . unBitStreamBuilder@@ -79,3 +86,15 @@   : (x .&.   1 /= 0)   : toBitStream xs toBitStream [] = []++instance Show ByteStreamBuilder where+  show b =+    intercalate ", " (map go (DL.toList $ unBitStreamBuilder b)) +++    " aka " +++    intercalate "," (map (hexit . fromIntegral) (toList (b <> encodeBits 7 0))) +++    go2 (Codec.QRCode.Data.ByteStreamBuilder.length b `mod` 8)+    where+      hexit a = [intToDigit (a `shiftR` 4), intToDigit (a .&. 0x0f)]+      go (n, b') = show b' ++ '/' : show n+      go2 0 = ""+      go2 n = '/':show n
src/Codec/QRCode/Data/ErrorLevel.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE StandaloneDeriving #-}  module Codec.QRCode.Data.ErrorLevel   ( ErrorLevel(..)@@ -13,3 +14,5 @@   | Q -- ^ Allows error recovery up to 25%   | H -- ^ Allows error recovery up to 30%   deriving (Bounded, Enum, Eq)++deriving instance Show ErrorLevel
src/Codec/QRCode/Data/MQRImage.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE StrictData #-}  module Codec.QRCode.Data.MQRImage   ( MQRImage1(..)@@ -25,29 +24,29 @@  data MQRImage1 s   = MQRImage1-    { mqrImage1Size       :: Int-    , mqrImage1Data       :: MUV.MVector s Bool-    , mqrImage1Fixed      :: MUV.MVector s Bool-    , mqrImage1Version    :: Version-    , mqrImage1ErrorLevel :: ErrorLevel+    { mqrImage1Size       :: !Int+    , mqrImage1Data       :: !(MUV.MVector s Bool)+    , mqrImage1Fixed      :: !(MUV.MVector s Bool)+    , mqrImage1Version    :: !Version+    , mqrImage1ErrorLevel :: !ErrorLevel     }  data MQRImage2 s   = MQRImage2-    { mqrImage2Size       :: Int-    , mqrImage2Data       :: MUV.MVector s Bool-    , mqrImage2Fixed      :: UV.Vector Bool-    , mqrImage2Version    :: Version-    , mqrImage2ErrorLevel :: ErrorLevel+    { mqrImage2Size       :: !Int+    , mqrImage2Data       :: !(MUV.MVector s Bool)+    , mqrImage2Fixed      :: !(UV.Vector Bool)+    , mqrImage2Version    :: !Version+    , mqrImage2ErrorLevel :: !ErrorLevel     }  data MQRImage3 s   = MQRImage3-    { mqrImage3Size       :: Int-    , mqrImage3Data       :: MUV.MVector s Bool-    , mqrImage3Fixed      :: UV.Vector Bool-    , mqrImage3Version    :: Version-    , mqrImage3ErrorLevel :: ErrorLevel+    { mqrImage3Size       :: !Int+    , mqrImage3Data       :: !(MUV.MVector s Bool)+    , mqrImage3Fixed      :: !(UV.Vector Bool)+    , mqrImage3Version    :: !Version+    , mqrImage3ErrorLevel :: !ErrorLevel     }  new :: PrimMonad m => Version -> ErrorLevel -> m (MQRImage1 (PrimState m))
src/Codec/QRCode/Data/Mask.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE StandaloneDeriving #-}  module Codec.QRCode.Data.Mask   ( Mask(..)@@ -17,3 +18,5 @@   | Mask6   | Mask7   deriving (Bounded, Enum, Eq)++deriving instance Show Mask
src/Codec/QRCode/Data/QRCodeOptions.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE StrictData #-}  module Codec.QRCode.Data.QRCodeOptions   ( QRCodeOptions(..)@@ -13,11 +12,11 @@  data QRCodeOptions   = QRCodeOptions-    { qroMinVersion      :: Int        -- ^ Minimal version (i.e. size) the qr code may have-    , qroMaxVersion      :: Int        -- ^ Maximal version (i.e. size) the qr code may have-    , qroErrorLevel      :: ErrorLevel -- ^ Selected error correction level-    , qroBoostErrorLevel :: Bool       -- ^ Increase error correction level within the same version if possible-    , qroMask            :: Maybe Mask -- ^ Specify a mask to be used, only use it if you know what you're doing+    { qroMinVersion      :: !Int          -- ^ Minimal version (i.e. size) the qr code may have+    , qroMaxVersion      :: !Int          -- ^ Maximal version (i.e. size) the qr code may have+    , qroErrorLevel      :: !ErrorLevel   -- ^ Selected error correction level+    , qroBoostErrorLevel :: !Bool         -- ^ Increase error correction level within the same version if possible+    , 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
src/Codec/QRCode/Data/QRImage.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE StrictData #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-}  module Codec.QRCode.Data.QRImage@@ -17,10 +17,10 @@  data QRImage   = QRImage-    { qrVersion    :: Int-    , qrErrorLevel :: ErrorLevel-    , qrImageSize  :: Int-    , qrImageData  :: UV.Vector Bool+    { qrVersion    :: !Int+    , qrErrorLevel :: !ErrorLevel+    , qrImageSize  :: !Int+    , qrImageData  :: !(UV.Vector Bool)     }  -- | Convert the QR code image into a list-type containing all@@ -65,3 +65,5 @@           (bool wh bl)           (UV.toList $ UV.take qrImageSize $ UV.drop (ofs * qrImageSize) qrImageData)         )++deriving instance Show QRImage
src/Codec/QRCode/Data/QRIntermediate/Internal.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE StrictData #-}+{-# LANGUAGE StandaloneDeriving #-}  module Codec.QRCode.Data.QRIntermediate.Internal   ( QRIntermediate(..)@@ -14,9 +14,11 @@  data QRIntermediate   = QRIntermediate-    { qrIntermediateVersion_    :: Version-    , qrIntermediateErrorLevel_ :: ErrorLevel-    , qrIntermediateDataSize_   :: Int-    , qrIntermediateData_       :: BSB.ByteStreamBuilder-    , qrIntermediateMask_       :: Maybe Mask+    { qrIntermediateVersion_    :: !Version+    , qrIntermediateErrorLevel_ :: !ErrorLevel+    , qrIntermediateDataSize_   :: !Int+    , qrIntermediateData_       :: !BSB.ByteStreamBuilder+    , qrIntermediateMask_       :: !(Maybe Mask)     }++deriving instance Show QRIntermediate
src/Codec/QRCode/Data/QRSegment/Internal.hs view
@@ -9,6 +9,8 @@  import           Codec.QRCode.Base +import           Data.List                           (intercalate)+ import qualified Codec.QRCode.Data.ByteStreamBuilder as BSB import           Codec.QRCode.Data.Result import           Codec.QRCode.Data.Version@@ -44,3 +46,10 @@     if l >= (1 `shiftL` n)       then empty       else pure $ BSB.encodeBits n l++instance Show QRSegment where+  show (QRSegment s) =+    "\n" ++ intercalate "\n" (map go [minBound .. maxBound]) ++ "\n"+    where+      go vr =+        show vr ++ ": " ++ show (getResult $ s vr)
src/Codec/QRCode/Data/Version.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE StandaloneDeriving #-}  module Codec.QRCode.Data.Version   ( Version@@ -28,3 +29,10 @@ versionsInRangeLimitedBy Version1to9   start end = map Version [start `max`  1 .. end `min`  9] versionsInRangeLimitedBy Version10to26 start end = map Version [start `max` 10 .. end `min` 26] versionsInRangeLimitedBy Version27to40 start end = map Version [start `max` 27 .. end `min` 40]++deriving instance Show Version++instance Show VersionRange where+  show Version1to9   = "Version  1- 9"+  show Version10to26 = "Version 10-26"+  show Version27to40 = "Version 27-40"
+ src/Codec/QRCode/Intermediate/Special.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE BinaryLiterals #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Codec.QRCode.Intermediate.Special+  ( emptyNumericSegment+  , emptyAlphanumericSegment+  , emptyByteSegment+  , emptyKanjiSegment+  ) where++import           Codec.QRCode.Base++import           Codec.QRCode.Data.QRSegment.Internal++emptyNumericSegment :: QRSegment+emptyNumericSegment =+  encodeBits 4 0b0001 <> lengthSegment (10, 12, 14) 0++emptyAlphanumericSegment :: QRSegment+emptyAlphanumericSegment =+  encodeBits 4 0b0010 <> lengthSegment (9, 11, 13) 0++emptyByteSegment :: QRSegment+emptyByteSegment =+  encodeBits 4 0b0100 <> lengthSegment (8, 16, 16) 0++emptyKanjiSegment :: QRSegment+emptyKanjiSegment =+  encodeBits 4 0b1000 <> lengthSegment (8, 10, 12) 0
src/Codec/QRCode/Mode/Alphanumeric.hs view
@@ -26,11 +26,10 @@ --    This can be archived by applying `Data.CaseInsensitive.mk` to the input. alphanumeric :: ToText a => a -> Result QRSegment alphanumeric s =-  ((encodeBits 4 0b0010 <> lengthSegment (9, 11, 13) (length s')) <>) . constStream-  <$> alphanumericB (isCI s) s'-  where-    s' :: [Char]-    s' = toString s+  case toString s of+    [] -> pure (constStream mempty)+    s' -> ((encodeBits 4 0b0010 <> lengthSegment (9, 11, 13) (length s')) <>) . constStream+          <$> alphanumericB (isCI s) s'  alphanumericB :: Bool -> [Char] -> Result BSB.ByteStreamBuilder alphanumericB ci s = go <$> traverse (Result . (`M.lookup` alphanumericMap ci)) s
src/Codec/QRCode/Mode/Byte.hs view
@@ -18,10 +18,10 @@  -- | Generate a segment representing the specified binary data in byte mode. binary :: ToBinary a => a -> QRSegment-binary s = encodeBits 4 0b0100 <> lengthSegment (8, 16, 16) (length s') <> constStream (BSB.fromList s')-  where-    s' :: [Word8]-    s' = toBinary s+binary s =+  case toBinary s of+    [] -> constStream mempty+    s' -> encodeBits 4 0b0100 <> lengthSegment (8, 16, 16) (length s') <> constStream (BSB.fromList s')  -- | Generate a segment representing the specified text data encoded as ISO-8859-1 or UTF-8 --   (with or without ECI) in byte mode.@@ -31,14 +31,19 @@ --   In case you want to encode as ISO-8859-1 and already have a [Word8] or similar --   you can use 'binary' as it creates the same result. text :: ToText a => TextEncoding -> a -> Result QRSegment-text Iso8859_1 s                 = textIso8859_1 s-text Utf8WithoutECI s            = pure (textUtf8WithoutECI s)-text Utf8WithECI s               = pure (textUtf8WithECI s)-text Iso8859_1OrUtf8WithoutECI s = textIso8859_1 s <|> pure (textUtf8WithoutECI s)-text Iso8859_1OrUtf8WithECI s    = textIso8859_1 s <|> pure (textUtf8WithECI s)+text te s =+  case te of+    Iso8859_1                 -> textIso8859_1 s'+    Utf8WithoutECI            -> textUtf8WithoutECI s'+    Utf8WithECI               -> textUtf8WithECI s'+    Iso8859_1OrUtf8WithoutECI -> textIso8859_1 s' <|> textUtf8WithoutECI s'+    Iso8859_1OrUtf8WithECI    -> textIso8859_1 s' <|> textUtf8WithECI s'+  where+    s' :: [Char]+    s' = toString s -textIso8859_1 :: ToText a => a -> Result QRSegment-textIso8859_1 s = binary <$> traverse go (toString s)+textIso8859_1 :: [Char] -> Result QRSegment+textIso8859_1 s = binary <$> traverse go s   where     go :: Char -> Result Word8     go c =@@ -49,44 +54,38 @@           then pure (fromIntegral c')           else empty -textUtf8WithoutECI :: ToText a => a -> QRSegment-textUtf8WithoutECI s = binary (encodeUtf8 $ toString s)+textUtf8WithoutECI :: [Char] -> Result QRSegment+textUtf8WithoutECI s = binary <$> encodeUtf8 s -textUtf8WithECI :: ToText a => a -> QRSegment-textUtf8WithECI s = eciEx 26 <> textUtf8WithoutECI s+textUtf8WithECI :: [Char] -> Result QRSegment+textUtf8WithECI s = (<>) <$> eci 26 <*> textUtf8WithoutECI s -encodeUtf8 :: [Char] -> [Word8]-encodeUtf8 = map fromIntegral . go- where-  go [] = []-  go (c:cs) =-    case ord c of-      oc-        | oc < 0 ->-            0xef-          : 0xbf-          : 0xbd-          : go cs-        | oc < 0x80 ->-            oc-          : go cs-        | oc < 0x800 ->-            0xc0 + (oc `shiftR` 6)-          : 0x80 + oc .&. 0x3f-          : go cs-        | oc < 0x10000 ->-            0xe0 + (oc `shiftR` 12)-          : 0x80 + ((oc `shiftR` 6) .&. 0x3f)-          : 0x80 + oc .&. 0x3f-          : go cs-        | oc < 0x110000 ->-            0xf0 + (oc `shiftR` 18)-          : 0x80 + ((oc `shiftR` 12) .&. 0x3f)-          : 0x80 + ((oc `shiftR` 6) .&. 0x3f)-          : 0x80 + oc .&. 0x3f-          : go cs-        | otherwise ->-            0xef-          : 0xbf-          : 0xbd-          : go cs+encodeUtf8 :: [Char] -> Result [Word8]+encodeUtf8 = (map fromIntegral <$>) . sequence . go+  where+    go [] = []+    go (c:cs) =+      case ord c of+        oc+          | oc < 0 ->+              [empty]+          | oc < 0x80 ->+              pure oc+            : go cs+          | oc < 0x800 ->+              pure (0xc0 + (oc `shiftR` 6))+            : pure (0x80 + oc .&. 0x3f)+            : go cs+          | oc < 0x10000 ->+              pure (0xe0 + (oc `shiftR` 12))+            : pure (0x80 + ((oc `shiftR` 6) .&. 0x3f))+            : pure (0x80 + oc .&. 0x3f)+            : go cs+          | oc < 0x110000 ->+              pure (0xf0 + (oc `shiftR` 18))+            : pure (0x80 + ((oc `shiftR` 12) .&. 0x3f))+            : pure (0x80 + ((oc `shiftR` 6) .&. 0x3f))+            : pure (0x80 + oc .&. 0x3f)+            : go cs+          | otherwise ->+              [empty]
src/Codec/QRCode/Mode/ECI.hs view
@@ -2,8 +2,7 @@ {-# LANGUAGE NoImplicitPrelude #-}  module Codec.QRCode.Mode.ECI-  ( eciEx-  , eci+  ( eci   ) where  import           Codec.QRCode.Base@@ -12,16 +11,10 @@ import           Codec.QRCode.Data.QRSegment.Internal import           Codec.QRCode.Data.Result -eciEx :: Int -> QRSegment-eciEx = constStream . eciExB- -- | Generate a segment representing an Extended Channel Interpretation --   (ECI) designator with the specified assignment value. eci :: Int -> Result QRSegment eci = fmap constStream . eciB--eciExB :: Int -> BSB.ByteStreamBuilder-eciExB = fromMaybe (error "Invalid ECI Code") . getResult . eciB  eciB :: Int -> Result BSB.ByteStreamBuilder eciB n
src/Codec/QRCode/Mode/Kanji.hs view
@@ -25,10 +25,10 @@ -- --   But it is possible to encode some of it and combine it with others like ISO-8859-1. kanji :: ToText a => a -> Result QRSegment-kanji s = ((encodeBits 4 0b1000 <> lengthSegment (8, 10, 12) (length s')) <>) . constStream <$> kanjiB s'-  where-    s' :: [Char]-    s' = toString s+kanji s =+  case toString s of+    [] -> pure (constStream mempty)+    s' -> ((encodeBits 4 0b1000 <> lengthSegment (8, 10, 12) (length s')) <>) . constStream <$> kanjiB s'  kanjiB :: [Char] -> Result BSB.ByteStreamBuilder kanjiB s = Result $ mconcat <$> traverse (fmap (BSB.encodeBits 13 . fromIntegral) . (`M.lookup` kanjiMap)) s
src/Codec/QRCode/Mode/Mixed.hs view
@@ -31,19 +31,23 @@  mixed :: ToText a => TextEncoding -> a -> Result QRSegment mixed te s =-  case te of-    Iso8859_1                 -> encIso1-    Utf8WithoutECI            -> encUtf8-    Utf8WithECI               -> encUtf8Eci-    Iso8859_1OrUtf8WithoutECI -> encIso1 <|> encUtf8-    Iso8859_1OrUtf8WithECI    -> encIso1 <|> encUtf8Eci+  case s' of+    [] ->+      pure (constStream mempty)+    _ ->+      case te of+        Iso8859_1                 -> encIso1+        Utf8WithoutECI            -> encUtf8+        Utf8WithECI               -> encUtf8Eci+        Iso8859_1OrUtf8WithoutECI -> encIso1 <|> encUtf8+        Iso8859_1OrUtf8WithECI    -> encIso1 <|> encUtf8Eci   where     encIso1 :: Result QRSegment     encIso1 = run EncISO1 <$> toIso1 ci s'     encUtf8 :: Result QRSegment     encUtf8 = run EncUtf8 <$> toUtf8 ci s'     encUtf8Eci :: Result QRSegment-    encUtf8Eci = (eciEx 26 <>) <$> encUtf8+    encUtf8Eci = (<>) <$> eci 26 <*> encUtf8     s' :: [Char]     s' = toString s     ci = isCI s@@ -146,7 +150,7 @@     (TNumeric,      _) -> go 0b0001 i =<< numericB (DL.toList s)     (TAlphanumeric, _) -> go 0b0010 i =<< alphanumericB True (DL.toList s)     (T8Bit,   EncISO1) -> go 0b0100 j (BSB.fromList $ map (fromIntegral . ord) (DL.toList s))-    (T8Bit,   EncUtf8) -> go 0b0100 j (BSB.fromList $ encodeUtf8 $ DL.toList s)+    (T8Bit,   EncUtf8) -> go 0b0100 j =<< BSB.fromList <$> encodeUtf8 (DL.toList s)     (TKanji,        _) -> go 0b1000 i =<< kanjiB (DL.toList s)   where     go :: Int -> Int -> BSB.ByteStreamBuilder -> Result BSB.ByteStreamBuilder
src/Codec/QRCode/Mode/Numeric.hs view
@@ -16,10 +16,9 @@ -- | Generate a segment representing the specified string of decimal digits encoded in numeric mode. numeric :: ToNumeric a => a -> Result QRSegment numeric s =-  ((encodeBits 4 0b0001 <> lengthSegment (10, 12, 14) (length s')) <>) . constStream <$> numericB s'-  where-    s' :: [Int]-    s' = toNumeric s+  case toNumeric s of+    [] -> pure (constStream mempty)+    s' -> ((encodeBits 4 0b0001 <> lengthSegment (10, 12, 14) (length s')) <>) . constStream <$> numericB s'  numericB :: ToNumeric a => a -> Result BSB.ByteStreamBuilder numericB s