{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE FlexibleContexts      #-}
-- | Helper functions for taking a list of
--   processed records, and returning
--   the same list splitted into separate colspans.
module Render.ColSpan where

import Data.Function(on)
import Data.Text (Text)
import Data.List(groupBy, sortBy)
import Prelude hiding(getLine)
import Optics.Core ( Field1(_1), Field2(_2), view, (%))
import Control.Exception(assert)

import Alignment
    ( textContent, tokenType, Align(ALeft), Processed )
import FindColumns ( alignPos, getLine, getLineCol )
import Token(MyTok)
import Util ( maybeLens )

-- | A list of tokens to be put into a single colspan,
--   Number of table columns in this colspan, and alignment option.
type TokensWithColSpan = ([(MyTok, Text)], Int, Align)

-- | Find colspan parameters
colspans   :: [Processed] -> [[TokensWithColSpan]]
colspans :: [Processed] -> [[TokensWithColSpan]]
colspans [Processed]
ps = ([Processed] -> [TokensWithColSpan])
-> [[Processed]] -> [[TokensWithColSpan]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( (([Processed], Int, Align) -> TokensWithColSpan)
-> [([Processed], Int, Align)] -> [TokensWithColSpan]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Processed], Int, Align) -> TokensWithColSpan
forall {f :: * -> *} {a} {b} {c}.
(Functor f, Field1 a a MyTok MyTok, Field3 a a Text Text) =>
(f a, b, c) -> (f (MyTok, Text), b, c)
extractTokens -- extract token and text content from each record
                   ([([Processed], Int, Align)] -> [TokensWithColSpan])
-> ([Processed] -> [([Processed], Int, Align)])
-> [Processed]
-> [TokensWithColSpan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Processed]] -> [([Processed], Int, Align)]
addColSpans -- add colspan length in alignment columns
                   ([[Processed]] -> [([Processed], Int, Align)])
-> ([Processed] -> [[Processed]])
-> [Processed]
-> [([Processed], Int, Align)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Processed -> Processed -> Bool) -> [Processed] -> [[Processed]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy Processed -> Processed -> Bool
sameColSpan ) -- group colspans
            ([[Processed]] -> [[TokensWithColSpan]])
-> [[Processed]] -> [[TokensWithColSpan]]
forall a b. (a -> b) -> a -> b
$ (Processed -> Processed -> Bool) -> [Processed] -> [[Processed]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==)    (Int -> Int -> Bool)
-> (Processed -> Int) -> Processed -> Processed -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Processed -> Int
forall a. Field2 a a MyLoc MyLoc => a -> Int
getLine) -- group lines
            ([Processed] -> [[Processed]]) -> [Processed] -> [[Processed]]
forall a b. (a -> b) -> a -> b
$ (Processed -> Processed -> Ordering) -> [Processed] -> [Processed]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy  ((Int, Int) -> (Int, Int) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((Int, Int) -> (Int, Int) -> Ordering)
-> (Processed -> (Int, Int)) -> Processed -> Processed -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Processed -> (Int, Int)
forall a. Field2 a a MyLoc MyLoc => a -> (Int, Int)
getLineCol) [Processed]
ps
  where
    maxCol :: Int
    maxCol :: Int
maxCol = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Processed -> Int) -> [Processed] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Processed -> Int
getAlignCol [Processed]
ps
    sameColSpan :: Processed -> Processed -> Bool
    sameColSpan :: Processed -> Processed -> Bool
sameColSpan Processed
tok1 Processed
tok2 = case Optic' A_Lens '[] Processed (Maybe (Align, Int))
-> Processed -> Maybe (Align, Int)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] Processed (Maybe (Align, Int))
forall a.
Field5 a a (Maybe (Align, Int)) (Maybe (Align, Int)) =>
Lens' a (Maybe (Align, Int))
alignPos Processed
tok2 of
                              Maybe (Align, Int)
Nothing | Processed -> Int
forall a. Field2 a a MyLoc MyLoc => a -> Int
getLine Processed
tok1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Processed -> Int
forall a. Field2 a a MyLoc MyLoc => a -> Int
getLine Processed
tok2 -> Bool
True
                              Maybe (Align, Int)
_                                      -> Bool
False
    addColSpans :: [[Processed]] -> [([Processed], Int, Align)]
    addColSpans :: [[Processed]] -> [([Processed], Int, Align)]
addColSpans []       = []
    addColSpans [[Processed]
a]      = [([Processed]
a, Int
maxCol Int -> Int -> Int
forall a. Num a => a -> a -> a
-Processed -> Int
getAlignCol ([Processed] -> Processed
forall a. HasCallStack => [a] -> a
head [Processed]
a)Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, Processed -> Align
getAlign (Processed -> Align) -> Processed -> Align
forall a b. (a -> b) -> a -> b
$ [Processed] -> Processed
forall a. HasCallStack => [a] -> a
head [Processed]
a)]
    addColSpans ([Processed]
b:[Processed]
c:[[Processed]]
cs) =  ([Processed]
b, Int
nextColInt -> Int -> Int
forall a. Num a => a -> a -> a
-Processed -> Int
getAlignCol ([Processed] -> Processed
forall a. HasCallStack => [a] -> a
head [Processed]
b)  , Processed -> Align
getAlign (Processed -> Align) -> Processed -> Align
forall a b. (a -> b) -> a -> b
$ [Processed] -> Processed
forall a. HasCallStack => [a] -> a
head [Processed]
b)([Processed], Int, Align)
-> [([Processed], Int, Align)] -> [([Processed], Int, Align)]
forall a. a -> [a] -> [a]
:[[Processed]] -> [([Processed], Int, Align)]
addColSpans ([Processed]
c[Processed] -> [[Processed]] -> [[Processed]]
forall a. a -> [a] -> [a]
:[[Processed]]
cs)
      where
        nextCol :: Int
nextCol = Processed -> Int
getAlignCol (Processed -> Int) -> Processed -> Int
forall a b. (a -> b) -> a -> b
$ [Processed] -> Processed
forall a. HasCallStack => [a] -> a
head [Processed]
c
    getAlign :: Processed -> Align
    getAlign :: Processed -> Align
getAlign = Optic' A_Lens '[] Processed Align -> Processed -> Align
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic' A_Lens '[] Processed (Maybe (Align, Int))
forall a.
Field5 a a (Maybe (Align, Int)) (Maybe (Align, Int)) =>
Lens' a (Maybe (Align, Int))
alignPos Optic' A_Lens '[] Processed (Maybe (Align, Int))
-> Optic
     A_Lens
     '[]
     (Maybe (Align, Int))
     (Maybe (Align, Int))
     (Align, Int)
     (Align, Int)
-> Optic A_Lens '[] Processed Processed (Align, Int) (Align, Int)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (Align, Int)
-> Optic
     A_Lens
     '[]
     (Maybe (Align, Int))
     (Maybe (Align, Int))
     (Align, Int)
     (Align, Int)
forall a a1. a -> Lens (Maybe a) (Maybe a1) a a1
maybeLens (Align
ALeft, Int
1) Optic A_Lens '[] Processed Processed (Align, Int) (Align, Int)
-> Optic A_Lens '[] (Align, Int) (Align, Int) Align Align
-> Optic' A_Lens '[] Processed Align
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] (Align, Int) (Align, Int) Align Align
forall s t a b. Field1 s t a b => Lens s t a b
_1)
    extractTokens :: (f a, b, c) -> (f (MyTok, Text), b, c)
extractTokens (f a
a,b
b,c
c) = (a -> (MyTok, Text)
forall {s}.
(Field1 s s MyTok MyTok, Field3 s s Text Text) =>
s -> (MyTok, Text)
extractToken (a -> (MyTok, Text)) -> f a -> f (MyTok, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
a, b
b, c
c)
    extractToken :: s -> (MyTok, Text)
extractToken s
tok = (Optic' A_Lens '[] s MyTok -> s -> MyTok
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] s MyTok
forall a. Field1 a a MyTok MyTok => Lens' a MyTok
tokenType s
tok, Optic' A_Lens '[] s Text -> s -> Text
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens '[] s Text
forall a. Field3 a a Text Text => Lens' a Text
textContent s
tok)
-- FIXME: split lines before colspans!

numColSpans :: [Processed] -> Int
numColSpans :: [Processed] -> Int
numColSpans [Processed]
ps = case [Int]
colspansPerLine of
                   []   -> Int
1
                   Int
n:[Int]
ns -> Bool -> Int -> Int
forall a. HasCallStack => Bool -> a -> a
assert ((Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int
nInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==) [Int]
ns) Int
n
  where
    colspansPerLine :: [Int]
    colspansPerLine :: [Int]
colspansPerLine = ([TokensWithColSpan] -> Int) -> [[TokensWithColSpan]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int)
-> ([TokensWithColSpan] -> [Int]) -> [TokensWithColSpan] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TokensWithColSpan -> Int) -> [TokensWithColSpan] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\([(MyTok, Text)]
_,Int
c,Align
_) -> Int
c)) ([[TokensWithColSpan]] -> [Int])
-> ([Processed] -> [[TokensWithColSpan]]) -> [Processed] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Processed] -> [[TokensWithColSpan]]
colspans ([Processed] -> [Int]) -> [Processed] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Processed]
ps

-- | Given a `Processed` record, extract number of table columns.
getAlignCol :: Processed -> Int
getAlignCol :: Processed -> Int
getAlignCol = Optic' A_Lens '[] Processed Int -> Processed -> Int
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic' A_Lens '[] Processed (Maybe (Align, Int))
forall a.
Field5 a a (Maybe (Align, Int)) (Maybe (Align, Int)) =>
Lens' a (Maybe (Align, Int))
alignPos Optic' A_Lens '[] Processed (Maybe (Align, Int))
-> Optic
     A_Lens
     '[]
     (Maybe (Align, Int))
     (Maybe (Align, Int))
     (Align, Int)
     (Align, Int)
-> Optic A_Lens '[] Processed Processed (Align, Int) (Align, Int)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (Align, Int)
-> Optic
     A_Lens
     '[]
     (Maybe (Align, Int))
     (Maybe (Align, Int))
     (Align, Int)
     (Align, Int)
forall a a1. a -> Lens (Maybe a) (Maybe a1) a a1
maybeLens (Align
ALeft, Int
0) Optic A_Lens '[] Processed Processed (Align, Int) (Align, Int)
-> Optic A_Lens '[] (Align, Int) (Align, Int) Int Int
-> Optic' A_Lens '[] Processed Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] (Align, Int) (Align, Int) Int Int
forall s t a b. Field2 s t a b => Lens s t a b
_2)