diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 diff --git a/qrcode-core.cabal b/qrcode-core.cabal --- a/qrcode-core.cabal +++ b/qrcode-core.cabal @@ -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 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 diff --git a/src/Codec/QRCode/Code/Data.hs b/src/Codec/QRCode/Code/Data.hs --- a/src/Codec/QRCode/Code/Data.hs +++ b/src/Codec/QRCode/Code/Data.hs @@ -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 diff --git a/src/Codec/QRCode/Data/ByteStreamBuilder.hs b/src/Codec/QRCode/Data/ByteStreamBuilder.hs --- a/src/Codec/QRCode/Data/ByteStreamBuilder.hs +++ b/src/Codec/QRCode/Data/ByteStreamBuilder.hs @@ -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 diff --git a/src/Codec/QRCode/Data/ErrorLevel.hs b/src/Codec/QRCode/Data/ErrorLevel.hs --- a/src/Codec/QRCode/Data/ErrorLevel.hs +++ b/src/Codec/QRCode/Data/ErrorLevel.hs @@ -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 diff --git a/src/Codec/QRCode/Data/MQRImage.hs b/src/Codec/QRCode/Data/MQRImage.hs --- a/src/Codec/QRCode/Data/MQRImage.hs +++ b/src/Codec/QRCode/Data/MQRImage.hs @@ -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)) diff --git a/src/Codec/QRCode/Data/Mask.hs b/src/Codec/QRCode/Data/Mask.hs --- a/src/Codec/QRCode/Data/Mask.hs +++ b/src/Codec/QRCode/Data/Mask.hs @@ -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 diff --git a/src/Codec/QRCode/Data/QRCodeOptions.hs b/src/Codec/QRCode/Data/QRCodeOptions.hs --- a/src/Codec/QRCode/Data/QRCodeOptions.hs +++ b/src/Codec/QRCode/Data/QRCodeOptions.hs @@ -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 diff --git a/src/Codec/QRCode/Data/QRImage.hs b/src/Codec/QRCode/Data/QRImage.hs --- a/src/Codec/QRCode/Data/QRImage.hs +++ b/src/Codec/QRCode/Data/QRImage.hs @@ -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 diff --git a/src/Codec/QRCode/Data/QRIntermediate/Internal.hs b/src/Codec/QRCode/Data/QRIntermediate/Internal.hs --- a/src/Codec/QRCode/Data/QRIntermediate/Internal.hs +++ b/src/Codec/QRCode/Data/QRIntermediate/Internal.hs @@ -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 diff --git a/src/Codec/QRCode/Data/QRSegment/Internal.hs b/src/Codec/QRCode/Data/QRSegment/Internal.hs --- a/src/Codec/QRCode/Data/QRSegment/Internal.hs +++ b/src/Codec/QRCode/Data/QRSegment/Internal.hs @@ -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) diff --git a/src/Codec/QRCode/Data/Version.hs b/src/Codec/QRCode/Data/Version.hs --- a/src/Codec/QRCode/Data/Version.hs +++ b/src/Codec/QRCode/Data/Version.hs @@ -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" diff --git a/src/Codec/QRCode/Intermediate/Special.hs b/src/Codec/QRCode/Intermediate/Special.hs new file mode 100644 --- /dev/null +++ b/src/Codec/QRCode/Intermediate/Special.hs @@ -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 diff --git a/src/Codec/QRCode/Mode/Alphanumeric.hs b/src/Codec/QRCode/Mode/Alphanumeric.hs --- a/src/Codec/QRCode/Mode/Alphanumeric.hs +++ b/src/Codec/QRCode/Mode/Alphanumeric.hs @@ -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 diff --git a/src/Codec/QRCode/Mode/Byte.hs b/src/Codec/QRCode/Mode/Byte.hs --- a/src/Codec/QRCode/Mode/Byte.hs +++ b/src/Codec/QRCode/Mode/Byte.hs @@ -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] diff --git a/src/Codec/QRCode/Mode/ECI.hs b/src/Codec/QRCode/Mode/ECI.hs --- a/src/Codec/QRCode/Mode/ECI.hs +++ b/src/Codec/QRCode/Mode/ECI.hs @@ -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 diff --git a/src/Codec/QRCode/Mode/Kanji.hs b/src/Codec/QRCode/Mode/Kanji.hs --- a/src/Codec/QRCode/Mode/Kanji.hs +++ b/src/Codec/QRCode/Mode/Kanji.hs @@ -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 diff --git a/src/Codec/QRCode/Mode/Mixed.hs b/src/Codec/QRCode/Mode/Mixed.hs --- a/src/Codec/QRCode/Mode/Mixed.hs +++ b/src/Codec/QRCode/Mode/Mixed.hs @@ -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 diff --git a/src/Codec/QRCode/Mode/Numeric.hs b/src/Codec/QRCode/Mode/Numeric.hs --- a/src/Codec/QRCode/Mode/Numeric.hs +++ b/src/Codec/QRCode/Mode/Numeric.hs @@ -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