{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

module Kewar.Layout.FormatVersion (format, version, formatLocations, versionLocations) where

import Data.Maybe (fromJust, fromMaybe)
import Data.Tuple (swap)
import Kewar.Constants (formatBitString, versionBitString)
import Kewar.Layout.Constants (size)
import Kewar.Layout.Types (Module, Position, fromChar)
import Kewar.Types (CorrectionLevel, Version)

version :: Version -> [(Position, Module)]
version :: Version -> [(Position, Module)]
version Version
v = [Position] -> [Module] -> [(Position, Module)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Position]
bottomLeft [Module]
modules [(Position, Module)]
-> [(Position, Module)] -> [(Position, Module)]
forall a. [a] -> [a] -> [a]
++ [Position] -> [Module] -> [(Position, Module)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Position]
topRight [Module]
modules
  where
    modules :: [Module]
modules = (Char -> Module) -> [Char] -> [Module]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Module -> Module
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Module -> Module)
-> (Char -> Maybe Module) -> Char -> Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe Module
fromChar) ([Char] -> [Module]) -> [Char] -> [Module]
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"" (Maybe [Char] -> [Char]) -> Maybe [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Version -> Maybe [Char]
versionBitString Version
v
    [Position]
bottomLeft : [Position]
topRight : [[Position]]
_ = Version -> [[Position]]
versionLocations Version
v

format :: Int -> CorrectionLevel -> Int -> [(Position, Module)]
format :: Version -> CorrectionLevel -> Version -> [(Position, Module)]
format Version
v CorrectionLevel
cl Version
pattern = [Position] -> [Module] -> [(Position, Module)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Position]
tl [Module]
modules [(Position, Module)]
-> [(Position, Module)] -> [(Position, Module)]
forall a. [a] -> [a] -> [a]
++ [Position] -> [Module] -> [(Position, Module)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([[Position]] -> [Position]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Position]]
rest) [Module]
modules
  where
    modules :: [Module]
modules = (Char -> Module) -> [Char] -> [Module]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Module -> Module
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Module -> Module)
-> (Char -> Maybe Module) -> Char -> Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe Module
fromChar) ([Char] -> [Module]) -> [Char] -> [Module]
forall a b. (a -> b) -> a -> b
$ CorrectionLevel -> Version -> [Char]
formatBitString CorrectionLevel
cl Version
pattern
    [Position]
tl : [[Position]]
rest = Version -> [[Position]]
formatLocations Version
v

versionLocations :: Version -> [[Position]]
versionLocations :: Version -> [[Position]]
versionLocations Version
v
  | Version
v Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
7 = [[], []]
  | Bool
otherwise = [[Position]
l, (Position -> Position) -> [Position] -> [Position]
forall a b. (a -> b) -> [a] -> [b]
map Position -> Position
forall a b. (a, b) -> (b, a)
swap [Position]
l]
  where
    s :: Version
s = Version -> Version
size Version
v
    l :: [Position]
l = [(Version
j, Version
i) | Version
j <- [Version
0 .. Version
5], Version
i <- [Version
s Version -> Version -> Version
forall a. Num a => a -> a -> a
-Version
11 .. Version
s Version -> Version -> Version
forall a. Num a => a -> a -> a
-Version
9]]

formatLocations :: Int -> [[Position]]
formatLocations :: Version -> [[Position]]
formatLocations Version
v = do
  let topRight :: [Position]
topRight = [(Version
8, Version
i) | Version
i <- [Version] -> [Version]
forall a. [a] -> [a]
reverse [Version
s Version -> Version -> Version
forall a. Num a => a -> a -> a
-Version
7 .. Version
s Version -> Version -> Version
forall a. Num a => a -> a -> a
-Version
1]]
  let bottomLeft :: [Position]
bottomLeft = [(Version
i, Version
8) | Version
i <- [Version
s Version -> Version -> Version
forall a. Num a => a -> a -> a
-Version
8 .. Version
s Version -> Version -> Version
forall a. Num a => a -> a -> a
-Version
1]]
  let topLeft :: [Position]
topLeft = [(Version
i, Version
8) | Version
i <- [Version
0 .. Version
5] [Version] -> [Version] -> [Version]
forall a. [a] -> [a] -> [a]
++ [Version
7]] [Position] -> [Position] -> [Position]
forall a. [a] -> [a] -> [a]
++ [(Version
8, Version
i) | Version
i <- [Version] -> [Version]
forall a. [a] -> [a]
reverse ([Version
0 .. Version
5] [Version] -> [Version] -> [Version]
forall a. [a] -> [a] -> [a]
++ [Version
7, Version
8])]
  [[Position]
topLeft, [Position]
topRight, [Position]
bottomLeft]
  where
    s :: Version
s = Version -> Version
size Version
v