{-# 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 :: a -> QRSegment
binary a
s =
  case a -> [Word8]
forall a. ToBinary a => a -> [Word8]
toBinary a
s of
    [] -> ByteStreamBuilder -> QRSegment
constStream ByteStreamBuilder
forall a. Monoid a => a
mempty
    [Word8]
s' -> Int -> Int -> QRSegment
encodeBits Int
4 Int
0b0100 QRSegment -> QRSegment -> QRSegment
forall a. Semigroup a => a -> a -> a
<> (Int, Int, Int) -> Int -> QRSegment
lengthSegment (Int
8, Int
16, Int
16) ([Word8] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
s') QRSegment -> QRSegment -> QRSegment
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 :: 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' Result QRSegment -> Result QRSegment -> Result QRSegment
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' Result QRSegment -> Result QRSegment -> Result QRSegment
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Char] -> Result QRSegment
textUtf8WithECI [Char]
s'
  where
    s' :: [Char]
    s' :: [Char]
s' = a -> [Char]
forall a. ToText a => a -> [Char]
toString a
s

textIso8859_1 :: [Char] -> Result QRSegment
textIso8859_1 :: [Char] -> Result QRSegment
textIso8859_1 [Char]
s = [Word8] -> QRSegment
forall a. ToBinary a => a -> QRSegment
binary ([Word8] -> QRSegment) -> Result [Word8] -> Result QRSegment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Result Word8) -> [Char] -> Result [Word8]
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' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
c' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
255
          then Word8 -> Result Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c')
          else Result Word8
forall (f :: * -> *) a. Alternative f => f a
empty

textUtf8WithoutECI :: [Char] -> Result QRSegment
textUtf8WithoutECI :: [Char] -> Result QRSegment
textUtf8WithoutECI [Char]
s = [Word8] -> QRSegment
forall a. ToBinary a => a -> QRSegment
binary ([Word8] -> QRSegment) -> Result [Word8] -> Result QRSegment
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 = QRSegment -> QRSegment -> QRSegment
forall a. Semigroup a => a -> a -> a
(<>) (QRSegment -> QRSegment -> QRSegment)
-> Result QRSegment -> Result (QRSegment -> QRSegment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Result QRSegment
eci Int
26 Result (QRSegment -> QRSegment)
-> Result QRSegment -> Result QRSegment
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 = ((Int -> Word8) -> [Int] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [Word8]) -> Result [Int] -> Result [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Result [Int] -> Result [Word8])
-> ([Char] -> Result [Int]) -> [Char] -> Result [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Result Int] -> Result [Int]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Result Int] -> Result [Int])
-> ([Char] -> [Result Int]) -> [Char] -> Result [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Result Int]
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 ->
              [f Int
forall (f :: * -> *) a. Alternative f => f a
empty]
          | Int
oc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x80 ->
              Int -> f Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
oc
            f Int -> [f Int] -> [f Int]
forall a. a -> [a] -> [a]
: [Char] -> [f Int]
go [Char]
cs
          | Int
oc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x800 ->
              Int -> f Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0xc0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
oc Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
6))
            f Int -> [f Int] -> [f Int]
forall a. a -> [a] -> [a]
: Int -> f Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
oc Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3f)
            f Int -> [f Int] -> [f Int]
forall a. a -> [a] -> [a]
: [Char] -> [f Int]
go [Char]
cs
          | Int
oc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x10000 ->
              Int -> f Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0xe0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
oc Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
12))
            f Int -> [f Int] -> [f Int]
forall a. a -> [a] -> [a]
: Int -> f Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ((Int
oc Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
6) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3f))
            f Int -> [f Int] -> [f Int]
forall a. a -> [a] -> [a]
: Int -> f Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
oc Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3f)
            f Int -> [f Int] -> [f Int]
forall a. a -> [a] -> [a]
: [Char] -> [f Int]
go [Char]
cs
          | Int
oc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x110000 ->
              Int -> f Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0xf0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
oc Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
18))
            f Int -> [f Int] -> [f Int]
forall a. a -> [a] -> [a]
: Int -> f Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ((Int
oc Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
12) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3f))
            f Int -> [f Int] -> [f Int]
forall a. a -> [a] -> [a]
: Int -> f Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ((Int
oc Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
6) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3f))
            f Int -> [f Int] -> [f Int]
forall a. a -> [a] -> [a]
: Int -> f Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
0x80 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
oc Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3f)
            f Int -> [f Int] -> [f Int]
forall a. a -> [a] -> [a]
: [Char] -> [f Int]
go [Char]
cs
          | Bool
otherwise ->
              [f Int
forall (f :: * -> *) a. Alternative f => f a
empty]