{-# 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 :: forall a. ToBinary a => a -> QRSegment
binary a
s =
case forall a. ToBinary a => a -> [Word8]
toBinary a
s of
[] -> ByteStreamBuilder -> QRSegment
constStream forall a. Monoid a => a
mempty
[Word8]
s' -> Int -> Int -> QRSegment
encodeBits Int
4 Int
0b0100 forall a. Semigroup a => a -> a -> a
<> (Int, Int, Int) -> Int -> QRSegment
lengthSegment (Int
8, Int
16, Int
16) (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
s') forall a. Semigroup a => a -> a -> a
<> ByteStreamBuilder -> QRSegment
constStream ([Word8] -> ByteStreamBuilder
BSB.fromList [Word8]
s')
text :: ToText a => TextEncoding -> a -> Result QRSegment
text :: forall a. ToText a => TextEncoding -> a -> Result QRSegment
text TextEncoding
te a
s =
case TextEncoding
te of
TextEncoding
Iso8859_1 -> [Char] -> Result QRSegment
textIso8859_1 [Char]
s'
TextEncoding
Utf8WithoutECI -> [Char] -> Result QRSegment
textUtf8WithoutECI [Char]
s'
TextEncoding
Utf8WithECI -> [Char] -> Result QRSegment
textUtf8WithECI [Char]
s'
TextEncoding
Iso8859_1OrUtf8WithoutECI -> [Char] -> Result QRSegment
textIso8859_1 [Char]
s' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Result QRSegment
textUtf8WithoutECI [Char]
s'
TextEncoding
Iso8859_1OrUtf8WithECI -> [Char] -> Result QRSegment
textIso8859_1 [Char]
s' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Result QRSegment
textUtf8WithECI [Char]
s'
where
s' :: [Char]
s' :: [Char]
s' = forall a. ToText a => a -> [Char]
toString a
s
textIso8859_1 :: [Char] -> Result QRSegment
textIso8859_1 :: [Char] -> Result QRSegment
textIso8859_1 [Char]
s = forall a. ToBinary a => a -> QRSegment
binary forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Char -> Result Word8
go [Char]
s
where
go :: Char -> Result Word8
go :: Char -> Result Word8
go Char
c =
let
c' :: Int
c' = Char -> Int
ord Char
c
in
if Int
c' forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
c' forall a. Ord a => a -> a -> Bool
<= Int
255
then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c')
else forall (f :: * -> *) a. Alternative f => f a
empty
textUtf8WithoutECI :: [Char] -> Result QRSegment
textUtf8WithoutECI :: [Char] -> Result QRSegment
textUtf8WithoutECI [Char]
s = forall a. ToBinary a => a -> QRSegment
binary forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Result [Word8]
encodeUtf8 [Char]
s
textUtf8WithECI :: [Char] -> Result QRSegment
textUtf8WithECI :: [Char] -> Result QRSegment
textUtf8WithECI [Char]
s = forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Result QRSegment
eci Int
26 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> Result QRSegment
textUtf8WithoutECI [Char]
s
encodeUtf8 :: [Char] -> Result [Word8]
encodeUtf8 :: [Char] -> Result [Word8]
encodeUtf8 = (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {f :: * -> *}. Alternative f => [Char] -> [f Int]
go
where
go :: [Char] -> [f Int]
go [] = []
go (Char
c:[Char]
cs) =
case Char -> Int
ord Char
c of
Int
oc
| Int
oc forall a. Ord a => a -> a -> Bool
< Int
0 ->
[forall (f :: * -> *) a. Alternative f => f a
empty]
| Int
oc forall a. Ord a => a -> a -> Bool
< Int
0x80 ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
oc
forall a. a -> [a] -> [a]
: [Char] -> [f Int]
go [Char]
cs
| Int
oc forall a. Ord a => a -> a -> Bool
< Int
0x800 ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0xc0 forall a. Num a => a -> a -> a
+ (Int
oc forall a. Bits a => a -> Int -> a
`shiftR` Int
6))
forall a. a -> [a] -> [a]
: forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0x80 forall a. Num a => a -> a -> a
+ Int
oc forall a. Bits a => a -> a -> a
.&. Int
0x3f)
forall a. a -> [a] -> [a]
: [Char] -> [f Int]
go [Char]
cs
| Int
oc forall a. Ord a => a -> a -> Bool
< Int
0x10000 ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0xe0 forall a. Num a => a -> a -> a
+ (Int
oc forall a. Bits a => a -> Int -> a
`shiftR` Int
12))
forall a. a -> [a] -> [a]
: forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0x80 forall a. Num a => a -> a -> a
+ ((Int
oc forall a. Bits a => a -> Int -> a
`shiftR` Int
6) forall a. Bits a => a -> a -> a
.&. Int
0x3f))
forall a. a -> [a] -> [a]
: forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0x80 forall a. Num a => a -> a -> a
+ Int
oc forall a. Bits a => a -> a -> a
.&. Int
0x3f)
forall a. a -> [a] -> [a]
: [Char] -> [f Int]
go [Char]
cs
| Int
oc forall a. Ord a => a -> a -> Bool
< Int
0x110000 ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0xf0 forall a. Num a => a -> a -> a
+ (Int
oc forall a. Bits a => a -> Int -> a
`shiftR` Int
18))
forall a. a -> [a] -> [a]
: forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0x80 forall a. Num a => a -> a -> a
+ ((Int
oc forall a. Bits a => a -> Int -> a
`shiftR` Int
12) forall a. Bits a => a -> a -> a
.&. Int
0x3f))
forall a. a -> [a] -> [a]
: forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0x80 forall a. Num a => a -> a -> a
+ ((Int
oc forall a. Bits a => a -> Int -> a
`shiftR` Int
6) forall a. Bits a => a -> a -> a
.&. Int
0x3f))
forall a. a -> [a] -> [a]
: forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0x80 forall a. Num a => a -> a -> a
+ Int
oc forall a. Bits a => a -> a -> a
.&. Int
0x3f)
forall a. a -> [a] -> [a]
: [Char] -> [f Int]
go [Char]
cs
| Bool
otherwise ->
[forall (f :: * -> *) a. Alternative f => f a
empty]