module Kewar.Constants
  ( capacities,
    modeIndicator,
    characterCountIndicator,
    totalBits,
    toExponent,
    fromExponent,
    groupsCodeWords,
    errorCorrectionCodeWordsPerBlock,
    remainderBits,
    alignmentPatternLocations,
    alphaNumericValue,
    allowedAlphaNumericValues,
    formatBitString,
    versionBitString,
  )
where

import Data.IntMap (IntMap, fromList, (!))
import Data.List (find, foldl', isPrefixOf)
import Data.List.Split (splitOn)
import qualified Data.Map as Map
import Data.Maybe (fromJust)
import Data.Tuple (swap)
import Paths_kewar (getDataFileName)
import Kewar.Types (BitString, CorrectionLevel, Mode (AlphaNumeric, Byte, Numeric), Version)
import System.IO.Unsafe (unsafePerformIO)
import Utils (leftPad, readInt, toBin)

-- | Reads unsafely CSV data files from data-files. Not really proud.
unsafeReadCSVFile :: FilePath -> [[String]]
unsafeReadCSVFile :: FilePath -> [[FilePath]]
unsafeReadCSVFile FilePath
fileName = (FilePath -> [FilePath]) -> [FilePath] -> [[FilePath]]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
",") (FilePath -> [FilePath]
lines FilePath
fileAsString)
  where
    fileAsString :: FilePath
fileAsString = IO FilePath -> FilePath
forall a. IO a -> a
unsafePerformIO (IO FilePath -> FilePath) -> IO FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
readFile (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ IO FilePath -> FilePath
forall a. IO a -> a
unsafePerformIO (IO FilePath -> FilePath) -> IO FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
getDataFileName FilePath
fileName

-- | Returns bit string indicator for the Mode
modeIndicator :: Mode -> BitString
modeIndicator :: Mode -> FilePath
modeIndicator Mode
Numeric = FilePath
"0001"
modeIndicator Mode
AlphaNumeric = FilePath
"0010"
modeIndicator Mode
Byte = FilePath
"0100"

-- | Returns character capacity per Version
capacities :: CorrectionLevel -> Mode -> [(Version, Int)]
capacities :: CorrectionLevel -> Mode -> [(Version, Version)]
capacities CorrectionLevel
correctionLevel Mode
mode = do
  let perCorrectionLevel :: [[FilePath]]
perCorrectionLevel = ([FilePath] -> Bool) -> [[FilePath]] -> [[FilePath]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\[FilePath]
c -> [FilePath]
c [FilePath] -> Version -> FilePath
forall a. [a] -> Version -> a
!! Version
1 FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== CorrectionLevel -> FilePath
forall a. Show a => a -> FilePath
show CorrectionLevel
correctionLevel) [[FilePath]]
rawCapacities
  ([(Version, Version)] -> [FilePath] -> [(Version, Version)])
-> [(Version, Version)] -> [[FilePath]] -> [(Version, Version)]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\[(Version, Version)]
acc [FilePath]
c -> [(Version, Version)]
acc [(Version, Version)]
-> [(Version, Version)] -> [(Version, Version)]
forall a. [a] -> [a] -> [a]
++ [(FilePath -> Version
readInt (FilePath -> Version) -> FilePath -> Version
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall a. [a] -> a
head [FilePath]
c, FilePath -> Version
readInt (FilePath -> Version) -> FilePath -> Version
forall a b. (a -> b) -> a -> b
$ [FilePath]
c [FilePath] -> Version -> FilePath
forall a. [a] -> Version -> a
!! (Mode -> Version
modeIndex Mode
mode Version -> Version -> Version
forall a. Num a => a -> a -> a
+ Version
2))]) [] [[FilePath]]
perCorrectionLevel

characterCountIndicatorSize :: Version -> Mode -> Int
characterCountIndicatorSize :: Version -> Mode -> Version
characterCountIndicatorSize Version
v Mode
m
  | Version
v Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Version
1 .. Version
9] = [Version
10, Version
9, Version
8, Version
8] [Version] -> Version -> Version
forall a. [a] -> Version -> a
!! Version
i
  | Version
v Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Version
10 .. Version
26] = [Version
12, Version
11, Version
16, Version
10] [Version] -> Version -> Version
forall a. [a] -> Version -> a
!! Version
i
  | Bool
otherwise = [Version
14, Version
13, Version
16, Version
12] [Version] -> Version -> Version
forall a. [a] -> Version -> a
!! Version
i
  where
    i :: Version
i = Mode -> Version
modeIndex Mode
m

-- | Returns character count indicator, a binary, left-padded string
-- representing the length of the input
characterCountIndicator :: String -> Mode -> Version -> BitString
characterCountIndicator :: FilePath -> Mode -> Version -> FilePath
characterCountIndicator FilePath
i Mode
m Version
v = Version -> Char -> FilePath -> FilePath
leftPad (Version -> Mode -> Version
characterCountIndicatorSize Version
v Mode
m) Char
'0' FilePath
binaryLength
  where
    binaryLength :: FilePath
binaryLength = Version -> FilePath
toBin (FilePath -> Version
forall (t :: * -> *) a. Foldable t => t a -> Version
length FilePath
i)

-- | Returns total number of required bits
totalBits :: Version -> CorrectionLevel -> Int
totalBits :: Version -> CorrectionLevel -> Version
totalBits Version
v CorrectionLevel
cl = FilePath -> Version
readInt ([FilePath]
r [FilePath] -> Version -> FilePath
forall a. [a] -> Version -> a
!! Version
2) Version -> Version -> Version
forall a. Num a => a -> a -> a
* Version
8
  where
    r :: [FilePath]
r = Version -> CorrectionLevel -> [FilePath]
errorCodewordAndBlock Version
v CorrectionLevel
cl

-- | Returns a list of tuples such that (#Groups, #CodeWords per group) per group (1-based)
-- e.g. (groupsCodeWords version cl) !! 0 -> returns groups codeword information for group 1
groupsCodeWords :: Version -> CorrectionLevel -> [(Int, Int)]
groupsCodeWords :: Version -> CorrectionLevel -> [(Version, Version)]
groupsCodeWords Version
v CorrectionLevel
cl = [(FilePath -> Version
readInt ([FilePath]
r [FilePath] -> Version -> FilePath
forall a. [a] -> Version -> a
!! Version
4), FilePath -> Version
readInt ([FilePath]
r [FilePath] -> Version -> FilePath
forall a. [a] -> Version -> a
!! Version
5)), (FilePath -> Version
readInt ([FilePath]
r [FilePath] -> Version -> FilePath
forall a. [a] -> Version -> a
!! Version
6), FilePath -> Version
readInt ([FilePath]
r [FilePath] -> Version -> FilePath
forall a. [a] -> Version -> a
!! Version
7))]
  where
    r :: [FilePath]
r = Version -> CorrectionLevel -> [FilePath]
errorCodewordAndBlock Version
v CorrectionLevel
cl

errorCorrectionCodeWordsPerBlock :: Version -> CorrectionLevel -> Int
errorCorrectionCodeWordsPerBlock :: Version -> CorrectionLevel -> Version
errorCorrectionCodeWordsPerBlock Version
v CorrectionLevel
cl = FilePath -> Version
readInt (FilePath -> Version) -> FilePath -> Version
forall a b. (a -> b) -> a -> b
$ Version -> CorrectionLevel -> [FilePath]
errorCodewordAndBlock Version
v CorrectionLevel
cl [FilePath] -> Version -> FilePath
forall a. [a] -> Version -> a
!! Version
3

remainderBits :: Version -> Int
remainderBits :: Version -> Version
remainderBits Version
v = FilePath -> Version
readInt ([FilePath]
record [FilePath] -> Version -> FilePath
forall a. [a] -> Version -> a
!! Version
1)
  where
    record :: [FilePath]
record = Maybe [FilePath] -> [FilePath]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [FilePath] -> [FilePath]) -> Maybe [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ([FilePath] -> Bool) -> [[FilePath]] -> Maybe [FilePath]
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\[FilePath]
i -> [FilePath] -> FilePath
forall a. [a] -> a
head [FilePath]
i FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== Version -> FilePath
forall a. Show a => a -> FilePath
show Version
v) [[FilePath]]
rawRemainderBits

alignmentPatternLocations :: Version -> [(Int, Int)]
alignmentPatternLocations :: Version -> [(Version, Version)]
alignmentPatternLocations Version
v = [(Version
x Version -> Version -> Version
forall a. Num a => a -> a -> a
-Version
2, Version
y Version -> Version -> Version
forall a. Num a => a -> a -> a
-Version
2) | Version
x <- [Version]
baseCoordinates, Version
y <- [Version]
baseCoordinates] 
  where
    baseCoordinates :: [Version]
baseCoordinates = Map Version [Version] -> Version -> [Version]
forall k a. Ord k => Map k a -> k -> a
(Map.!) Map Version [Version]
rawAlignmentPatternLocations Version
v

alphaNumericValue :: Char -> Int
alphaNumericValue :: Char -> Version
alphaNumericValue = Map Char Version -> Char -> Version
forall k a. Ord k => Map k a -> k -> a
(Map.!) Map Char Version
rawAlphaNumericValues

allowedAlphaNumericValues :: [Char]
allowedAlphaNumericValues :: FilePath
allowedAlphaNumericValues = Map Char Version -> FilePath
forall k a. Map k a -> [k]
Map.keys Map Char Version
rawAlphaNumericValues

formatBitString :: CorrectionLevel -> Int -> BitString
formatBitString :: CorrectionLevel -> Version -> FilePath
formatBitString CorrectionLevel
errorCorrection Version
maskPattern = [FilePath]
record [FilePath] -> Version -> FilePath
forall a. [a] -> Version -> a
!! Version
2
  where
    record :: [FilePath]
record = Maybe [FilePath] -> [FilePath]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [FilePath] -> [FilePath]) -> Maybe [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ([FilePath] -> Bool) -> [[FilePath]] -> Maybe [FilePath]
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ([CorrectionLevel -> FilePath
forall a. Show a => a -> FilePath
show CorrectionLevel
errorCorrection, Version -> FilePath
forall a. Show a => a -> FilePath
show Version
maskPattern] [FilePath] -> [FilePath] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [[FilePath]]
rawFormatString

versionBitString :: Version -> Maybe BitString
versionBitString :: Version -> Maybe FilePath
versionBitString Version
v
  | Version
v Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
7 = Maybe FilePath
forall a. Maybe a
Nothing
  | Bool
otherwise = do
    case ([FilePath] -> Bool) -> [[FilePath]] -> Maybe [FilePath]
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\[FilePath]
i -> Version -> FilePath
forall a. Show a => a -> FilePath
show Version
v FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== [FilePath] -> FilePath
forall a. [a] -> a
head [FilePath]
i) [[FilePath]]
rawVersionString of
      Just [FilePath]
record -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
record [FilePath] -> Version -> FilePath
forall a. [a] -> Version -> a
!! Version
1
      Maybe [FilePath]
Nothing -> Maybe FilePath
forall a. Maybe a
Nothing

-- | DUMP

-- | Return the index of mode column in following tables
modeIndex :: Mode -> Int
modeIndex :: Mode -> Version
modeIndex Mode
Numeric = Version
0
modeIndex Mode
AlphaNumeric = Version
1
modeIndex Mode
Byte = Version
2

-- Version-Correction, Numeric, AlphaNumeric, Byte
rawCapacities :: [[String]]
rawCapacities :: [[FilePath]]
rawCapacities = FilePath -> [[FilePath]]
unsafeReadCSVFile FilePath
"capacities.csv"

-- EC = Error Correction, B= Block, CW= CodeWords
-- Version, EC, Total #CW, ECCW per B, #B in G1, #CW per G1's B, #B in G2, CW per G2's B
rawErrorCodewordsAndBlock :: [[String]]
rawErrorCodewordsAndBlock :: [[FilePath]]
rawErrorCodewordsAndBlock = FilePath -> [[FilePath]]
unsafeReadCSVFile FilePath
"errors.csv"

rawAlignmentPatternLocations :: Map.Map Int [Int]
rawAlignmentPatternLocations :: Map Version [Version]
rawAlignmentPatternLocations = [(Version, [Version])] -> Map Version [Version]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Version, [Version])] -> Map Version [Version])
-> [(Version, [Version])] -> Map Version [Version]
forall a b. (a -> b) -> a -> b
$ ([FilePath] -> (Version, [Version]))
-> [[FilePath]] -> [(Version, [Version])]
forall a b. (a -> b) -> [a] -> [b]
map [FilePath] -> (Version, [Version])
split ([[FilePath]] -> [(Version, [Version])])
-> [[FilePath]] -> [(Version, [Version])]
forall a b. (a -> b) -> a -> b
$ FilePath -> [[FilePath]]
unsafeReadCSVFile FilePath
"alignment.csv"
  where
    split :: [FilePath] -> (Version, [Version])
split [FilePath]
l = (FilePath -> Version
readInt FilePath
x, (FilePath -> Version) -> [FilePath] -> [Version]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Version
readInt [FilePath]
xs) where FilePath
x : [FilePath]
xs = [FilePath]
l

rawRemainderBits :: [[String]]
rawRemainderBits :: [[FilePath]]
rawRemainderBits = FilePath -> [[FilePath]]
unsafeReadCSVFile FilePath
"remainder.csv"

-- | We control both Version and CorrectionLevel, no need to handle Maybe
errorCodewordAndBlock :: Version -> CorrectionLevel -> [String]
errorCodewordAndBlock :: Version -> CorrectionLevel -> [FilePath]
errorCodewordAndBlock Version
v CorrectionLevel
cl = Maybe [FilePath] -> [FilePath]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [FilePath] -> [FilePath]) -> Maybe [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ([FilePath] -> Bool) -> [[FilePath]] -> Maybe [FilePath]
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\[FilePath]
r -> Version -> [FilePath] -> [FilePath]
forall a. Version -> [a] -> [a]
take Version
2 [FilePath]
r [FilePath] -> [FilePath] -> Bool
forall a. Eq a => a -> a -> Bool
== [Version -> FilePath
forall a. Show a => a -> FilePath
show Version
v, CorrectionLevel -> FilePath
forall a. Show a => a -> FilePath
show CorrectionLevel
cl]) [[FilePath]]
rawErrorCodewordsAndBlock

rawLogTable :: [(Int, Int)]
rawLogTable :: [(Version, Version)]
rawLogTable = ([FilePath] -> (Version, Version))
-> [[FilePath]] -> [(Version, Version)]
forall a b. (a -> b) -> [a] -> [b]
map [FilePath] -> (Version, Version)
split ([[FilePath]] -> [(Version, Version)])
-> [[FilePath]] -> [(Version, Version)]
forall a b. (a -> b) -> a -> b
$ FilePath -> [[FilePath]]
unsafeReadCSVFile FilePath
"logarithms.csv"
  where
    split :: [FilePath] -> (Version, Version)
split [FilePath]
l = (FilePath -> Version
readInt (FilePath -> Version) -> FilePath -> Version
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall a. [a] -> a
head [FilePath]
l, FilePath -> Version
readInt (FilePath -> Version) -> FilePath -> Version
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall a. [a] -> a
last [FilePath]
l)

rawAlphaNumericValues :: Map.Map Char Int
rawAlphaNumericValues :: Map Char Version
rawAlphaNumericValues = [(Char, Version)] -> Map Char Version
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Char, Version)]
s
  where
    s :: [(Char, Version)]
s = ([FilePath] -> (Char, Version))
-> [[FilePath]] -> [(Char, Version)]
forall a b. (a -> b) -> [a] -> [b]
map (\[FilePath]
i -> ((FilePath -> Char
forall a. [a] -> a
head (FilePath -> Char)
-> ([FilePath] -> FilePath) -> [FilePath] -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
forall a. [a] -> a
head) [FilePath]
i, (FilePath -> Version
readInt (FilePath -> Version)
-> ([FilePath] -> FilePath) -> [FilePath] -> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
forall a. [a] -> a
last) [FilePath]
i)) (FilePath -> [[FilePath]]
unsafeReadCSVFile FilePath
"alphanumeric.csv")

exponents :: IntMap Int
exponents :: IntMap Version
exponents = [(Version, Version)] -> IntMap Version
forall a. [(Version, a)] -> IntMap a
fromList [(Version, Version)]
rawLogTable

numbers :: IntMap Int
numbers :: IntMap Version
numbers = [(Version, Version)] -> IntMap Version
forall a. [(Version, a)] -> IntMap a
fromList (((Version, Version) -> (Version, Version))
-> [(Version, Version)] -> [(Version, Version)]
forall a b. (a -> b) -> [a] -> [b]
map (Version, Version) -> (Version, Version)
forall a b. (a, b) -> (b, a)
swap [(Version, Version)]
rawLogTable)

toExponent :: Int -> Int
toExponent :: Version -> Version
toExponent Version
0 = Version
0
toExponent Version
a = IntMap Version
exponents IntMap Version -> Version -> Version
forall a. IntMap a -> Version -> a
! Version
a

fromExponent :: Int -> Int
fromExponent :: Version -> Version
fromExponent Version
a = IntMap Version
numbers IntMap Version -> Version -> Version
forall a. IntMap a -> Version -> a
! Version
a

rawFormatString :: [[String]]
rawFormatString :: [[FilePath]]
rawFormatString = FilePath -> [[FilePath]]
unsafeReadCSVFile FilePath
"format.csv"

rawVersionString :: [[String]]
rawVersionString :: [[FilePath]]
rawVersionString = FilePath -> [[FilePath]]
unsafeReadCSVFile FilePath
"version.csv"