{-# 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

-- | Generate a segment representing the specified binary data in byte mode.
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')

-- | Generate a segment representing the specified text data encoded as ISO-8859-1 or UTF-8
--   (with or without ECI) in byte mode.
--
--   Please refer to `TextEncoding` on what the difference is.
--
--   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 :: 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]