{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Codec.QRCode.Mode.Byte
( binary
, text
, encodeUtf8
) where
import Codec.QRCode.Base
import qualified Codec.QRCode.Data.ByteStreamBuilder as BSB
import Codec.QRCode.Data.QRSegment.Internal
import Codec.QRCode.Data.Result
import Codec.QRCode.Data.TextEncoding
import Codec.QRCode.Data.ToInput
import Codec.QRCode.Mode.ECI
binary :: ToBinary a => a -> QRSegment
binary s =
case toBinary s of
[] -> constStream mempty
s' -> encodeBits 4 0b0100 <> lengthSegment (8, 16, 16) (length s') <> constStream (BSB.fromList s')
text :: ToText a => TextEncoding -> a -> Result QRSegment
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 :: [Char] -> Result QRSegment
textIso8859_1 s = binary <$> traverse go s
where
go :: Char -> Result Word8
go c =
let
c' = ord c
in
if c' >= 0 && c' <= 255
then pure (fromIntegral c')
else empty
textUtf8WithoutECI :: [Char] -> Result QRSegment
textUtf8WithoutECI s = binary <$> encodeUtf8 s
textUtf8WithECI :: [Char] -> Result QRSegment
textUtf8WithECI s = (<>) <$> eci 26 <*> textUtf8WithoutECI s
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]