module Kewar.Types
  ( Mode (..),
    CorrectionLevel (..),
    Exception (..),
    Version,
    BitString,
    Codeword,
    Block,
    Group,
  )
where

data Mode = Numeric | AlphaNumeric | Byte deriving (Mode -> Mode -> Bool
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c== :: Mode -> Mode -> Bool
Eq, Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
(Int -> Mode -> ShowS)
-> (Mode -> String) -> ([Mode] -> ShowS) -> Show Mode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mode] -> ShowS
$cshowList :: [Mode] -> ShowS
show :: Mode -> String
$cshow :: Mode -> String
showsPrec :: Int -> Mode -> ShowS
$cshowsPrec :: Int -> Mode -> ShowS
Show)

-- | Correction Level allows reading QR codes in case they get damaged or unreadable.
data CorrectionLevel
  = -- | allows up to 7% data recovery
    L
  | -- | allows up to 15% data recovery
    M
  | -- | allows up to 25% data recovery
    Q
  | -- | allows up to 30% data recovery
    H
  deriving (CorrectionLevel -> CorrectionLevel -> Bool
(CorrectionLevel -> CorrectionLevel -> Bool)
-> (CorrectionLevel -> CorrectionLevel -> Bool)
-> Eq CorrectionLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CorrectionLevel -> CorrectionLevel -> Bool
$c/= :: CorrectionLevel -> CorrectionLevel -> Bool
== :: CorrectionLevel -> CorrectionLevel -> Bool
$c== :: CorrectionLevel -> CorrectionLevel -> Bool
Eq)

instance Show CorrectionLevel where
  show :: CorrectionLevel -> String
show CorrectionLevel
L = String
"L"
  show CorrectionLevel
M = String
"M"
  show CorrectionLevel
Q = String
"Q"
  show CorrectionLevel
H = String
"H"

type Version = Int

type BitString = String -- TODO: how to enforce chars?

type Codeword = BitString -- of length 8. TODO: how to enforce length?

type Block = [BitString]

type Group = [Block]

data Exception = InvalidCharacterSet | InvalidMask deriving (Exception -> Exception -> Bool
(Exception -> Exception -> Bool)
-> (Exception -> Exception -> Bool) -> Eq Exception
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Exception -> Exception -> Bool
$c/= :: Exception -> Exception -> Bool
== :: Exception -> Exception -> Bool
$c== :: Exception -> Exception -> Bool
Eq, Int -> Exception
Exception -> Int
Exception -> [Exception]
Exception -> Exception
Exception -> Exception -> [Exception]
Exception -> Exception -> Exception -> [Exception]
(Exception -> Exception)
-> (Exception -> Exception)
-> (Int -> Exception)
-> (Exception -> Int)
-> (Exception -> [Exception])
-> (Exception -> Exception -> [Exception])
-> (Exception -> Exception -> [Exception])
-> (Exception -> Exception -> Exception -> [Exception])
-> Enum Exception
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Exception -> Exception -> Exception -> [Exception]
$cenumFromThenTo :: Exception -> Exception -> Exception -> [Exception]
enumFromTo :: Exception -> Exception -> [Exception]
$cenumFromTo :: Exception -> Exception -> [Exception]
enumFromThen :: Exception -> Exception -> [Exception]
$cenumFromThen :: Exception -> Exception -> [Exception]
enumFrom :: Exception -> [Exception]
$cenumFrom :: Exception -> [Exception]
fromEnum :: Exception -> Int
$cfromEnum :: Exception -> Int
toEnum :: Int -> Exception
$ctoEnum :: Int -> Exception
pred :: Exception -> Exception
$cpred :: Exception -> Exception
succ :: Exception -> Exception
$csucc :: Exception -> Exception
Enum)

instance Show Exception where
  show :: Exception -> String
show Exception
InvalidCharacterSet = String
"Input character set is not supported. Please provide a valid ISO 8859-1 string."
  show Exception
InvalidMask = String
"Provided mask is not valid. Please provide a value between 0-7."