module Kewar.Layout.Interleaving (interleave) where

import Data.List (transpose)
import Kewar.Constants (remainderBits)
import Kewar.Types (BitString, Group, Version)

interleave :: Version -> [Group] -> [Group] -> BitString
interleave :: Version -> [Group] -> [Group] -> BitString
interleave Version
v [Group]
dataGroups [Group]
errorGroups
  | [Group] -> Version
forall (t :: * -> *) a. Foldable t => t a -> Version
length [Group]
dataGroups Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
1 = [BitString] -> BitString
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Group -> [BitString]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Group -> [BitString])
-> ([Group] -> Group) -> [Group] -> [BitString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Group] -> Group
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) [Group]
dataGroups [BitString] -> [BitString] -> [BitString]
forall a. [a] -> [a] -> [a]
++ (Group -> [BitString]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Group -> [BitString])
-> ([Group] -> Group) -> [Group] -> [BitString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Group] -> Group
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) [Group]
errorGroups)
  | Bool
otherwise = do
    let dataBlocks :: Group
dataBlocks = [Group] -> Group
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Group]
dataGroups
    let errorBlocks :: Group
errorBlocks = [Group] -> Group
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Group]
errorGroups
    let interleaved :: BitString
interleaved = [BitString] -> BitString
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Group -> [BitString]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Group -> Group
forall a. [[a]] -> [[a]]
transpose Group
dataBlocks) [BitString] -> [BitString] -> [BitString]
forall a. [a] -> [a] -> [a]
++ Group -> [BitString]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Group -> Group
forall a. [[a]] -> [[a]]
transpose Group
errorBlocks))
    let remainder :: BitString
remainder = Version -> Char -> BitString
forall a. Version -> a -> [a]
replicate (Version -> Version
remainderBits Version
v) Char
'0'

    BitString
interleaved BitString -> BitString -> BitString
forall a. [a] -> [a] -> [a]
++ BitString
remainder