{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Codec.QRCode.Data.ToInput
  ( ToText(..)
  , ToNumeric(..)
  , ToBinary(..)
  ) where

import           Codec.QRCode.Base
import           Data.CaseInsensitive (CI, original)

import qualified Data.ByteString      as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text            as T
import qualified Data.Text.Lazy       as TL
import qualified Data.Vector          as V
import qualified Data.Vector.Storable as SV
import qualified Data.Vector.Unboxed  as UV


-- | Conversion into a String and the information if the text is case insensitive (relevant for alphanumeric encoding)
class ToText a where
  toString :: a -> [Char]
  isCI :: a -> Bool

instance ToText [Char] where
  toString :: [Char] -> [Char]
toString = [Char] -> [Char]
forall a. a -> a
id
  isCI :: [Char] -> Bool
isCI [Char]
_ = Bool
False

instance ToText TL.Text where
  toString :: Text -> [Char]
toString = Text -> [Char]
TL.unpack
  isCI :: Text -> Bool
isCI Text
_ = Bool
False

instance ToText T.Text where
  toString :: Text -> [Char]
toString = Text -> [Char]
T.unpack
  isCI :: Text -> Bool
isCI Text
_ = Bool
False

instance ToText a => ToText (CI a) where
  toString :: CI a -> [Char]
toString = a -> [Char]
forall a. ToText a => a -> [Char]
toString (a -> [Char]) -> (CI a -> a) -> CI a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI a -> a
forall s. CI s -> s
original
  isCI :: CI a -> Bool
isCI CI a
_ = Bool
True


-- | Conversion into an array of digits (each has to be 0-9)
class ToNumeric a where
  toNumeric :: a -> [Int]

instance ToNumeric [Int] where
  toNumeric :: [Int] -> [Int]
toNumeric = [Int] -> [Int]
forall a. a -> a
id

instance ToNumeric [Char] where
  toNumeric :: [Char] -> [Int]
toNumeric = (Char -> Int) -> [Char] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
48 (Int -> Int) -> (Char -> Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord)

instance ToNumeric T.Text where
  toNumeric :: Text -> [Int]
toNumeric = [Char] -> [Int]
forall a. ToNumeric a => a -> [Int]
toNumeric ([Char] -> [Int]) -> (Text -> [Char]) -> Text -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack

instance ToNumeric TL.Text where
  toNumeric :: Text -> [Int]
toNumeric = [Char] -> [Int]
forall a. ToNumeric a => a -> [Int]
toNumeric ([Char] -> [Int]) -> (Text -> [Char]) -> Text -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
TL.unpack


-- | Conversion into binary data
class ToBinary a where
  toBinary :: a -> [Word8]

instance ToBinary [Word8] where
  toBinary :: [Word8] -> [Word8]
toBinary = [Word8] -> [Word8]
forall a. a -> a
id

instance ToBinary BS.ByteString where
  toBinary :: ByteString -> [Word8]
toBinary = ByteString -> [Word8]
BS.unpack

instance ToBinary BL.ByteString where
  toBinary :: ByteString -> [Word8]
toBinary = ByteString -> [Word8]
BL.unpack

instance ToBinary (V.Vector Word8) where
  toBinary :: Vector Word8 -> [Word8]
toBinary = Vector Word8 -> [Word8]
forall a. Vector a -> [a]
V.toList

instance ToBinary (UV.Vector Word8) where
  toBinary :: Vector Word8 -> [Word8]
toBinary = Vector Word8 -> [Word8]
forall a. Unbox a => Vector a -> [a]
UV.toList

instance ToBinary (SV.Vector Word8) where
  toBinary :: Vector Word8 -> [Word8]
toBinary = Vector Word8 -> [Word8]
forall a. Storable a => Vector a -> [a]
SV.toList