{-# LANGUAGE BangPatterns              #-}
{-# LANGUAGE DeriveAnyClass            #-}
{-# LANGUAGE DeriveGeneric             #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE Strict                    #-}
module Experimenter.Eval.Table where

import           Control.DeepSeq
import           Control.Monad                (forM_)
import           Control.Monad.Logger
import           Data.List                    (foldl')
import qualified Data.Text                    as T
import           GHC.Generics

import           Text.LaTeX
import           Text.LaTeX.Base.Class
import           Text.LaTeX.Packages.TabularX
import           Text.Printf

data Table =
  Table !Row
        ![Row]
  deriving (Int -> Table -> ShowS
[Table] -> ShowS
Table -> String
(Int -> Table -> ShowS)
-> (Table -> String) -> ([Table] -> ShowS) -> Show Table
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Table] -> ShowS
$cshowList :: [Table] -> ShowS
show :: Table -> String
$cshow :: Table -> String
showsPrec :: Int -> Table -> ShowS
$cshowsPrec :: Int -> Table -> ShowS
Show, Table -> Table -> Bool
(Table -> Table -> Bool) -> (Table -> Table -> Bool) -> Eq Table
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Table -> Table -> Bool
$c/= :: Table -> Table -> Bool
== :: Table -> Table -> Bool
$c== :: Table -> Table -> Bool
Eq, (forall x. Table -> Rep Table x)
-> (forall x. Rep Table x -> Table) -> Generic Table
forall x. Rep Table x -> Table
forall x. Table -> Rep Table x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Table x -> Table
$cfrom :: forall x. Table -> Rep Table x
Generic, Table -> ()
(Table -> ()) -> NFData Table
forall a. (a -> ()) -> NFData a
rnf :: Table -> ()
$crnf :: Table -> ()
NFData)

newtype Row =
  Row [Cell]
  deriving (Int -> Row -> ShowS
[Row] -> ShowS
Row -> String
(Int -> Row -> ShowS)
-> (Row -> String) -> ([Row] -> ShowS) -> Show Row
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Row] -> ShowS
$cshowList :: [Row] -> ShowS
show :: Row -> String
$cshow :: Row -> String
showsPrec :: Int -> Row -> ShowS
$cshowsPrec :: Int -> Row -> ShowS
Show, Row -> Row -> Bool
(Row -> Row -> Bool) -> (Row -> Row -> Bool) -> Eq Row
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Row -> Row -> Bool
$c/= :: Row -> Row -> Bool
== :: Row -> Row -> Bool
$c== :: Row -> Row -> Bool
Eq, (forall x. Row -> Rep Row x)
-> (forall x. Rep Row x -> Row) -> Generic Row
forall x. Rep Row x -> Row
forall x. Row -> Rep Row x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Row x -> Row
$cfrom :: forall x. Row -> Rep Row x
Generic, Row -> ()
(Row -> ()) -> NFData Row
forall a. (a -> ()) -> NFData a
rnf :: Row -> ()
$crnf :: Row -> ()
NFData)


data Cell
  = CellT !Text
  | CellD !Double
  | CellL !LaTeX
  | CellEmpty
  deriving (Int -> Cell -> ShowS
[Cell] -> ShowS
Cell -> String
(Int -> Cell -> ShowS)
-> (Cell -> String) -> ([Cell] -> ShowS) -> Show Cell
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cell] -> ShowS
$cshowList :: [Cell] -> ShowS
show :: Cell -> String
$cshow :: Cell -> String
showsPrec :: Int -> Cell -> ShowS
$cshowsPrec :: Int -> Cell -> ShowS
Show, Cell -> Cell -> Bool
(Cell -> Cell -> Bool) -> (Cell -> Cell -> Bool) -> Eq Cell
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cell -> Cell -> Bool
$c/= :: Cell -> Cell -> Bool
== :: Cell -> Cell -> Bool
$c== :: Cell -> Cell -> Bool
Eq, (forall x. Cell -> Rep Cell x)
-> (forall x. Rep Cell x -> Cell) -> Generic Cell
forall x. Rep Cell x -> Cell
forall x. Cell -> Rep Cell x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Cell x -> Cell
$cfrom :: forall x. Cell -> Rep Cell x
Generic)

instance NFData Cell where
  rnf :: Cell -> ()
rnf (CellT !Text
_) = ()
  rnf (CellD Double
x)  = Double -> ()
forall a. NFData a => a -> ()
rnf Double
x
  rnf (CellL !LaTeX
_) = ()
  rnf Cell
CellEmpty  = ()


instance IsString Cell where
  fromString :: String -> Cell
fromString = Text -> Cell
CellT (Text -> Cell) -> (String -> Text) -> String -> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

dereferLatex :: T.Text -> T.Text
dereferLatex :: Text -> Text
dereferLatex = Text -> Text
protectText (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
"{" Text
"\\{" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
"}" Text
"\\}" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
"_" Text
"\\_"

printTextwidthTable :: (MonadLogger m) => Table -> LaTeXT m ()
printTextwidthTable :: Table -> LaTeXT m ()
printTextwidthTable = Bool -> Table -> LaTeXT m ()
forall (m :: * -> *). MonadLogger m => Bool -> Table -> LaTeXT m ()
printTableTabularX Bool
True

printTable :: (MonadLogger m) => Table -> LaTeXT m ()
printTable :: Table -> LaTeXT m ()
printTable = Bool -> Table -> LaTeXT m ()
forall (m :: * -> *). MonadLogger m => Bool -> Table -> LaTeXT m ()
printTableTabularX Bool
False


printTableTabularX :: (MonadLogger m) => Bool -> Table -> LaTeXT m ()
printTableTabularX :: Bool -> Table -> LaTeXT m ()
printTableTabularX Bool
tabX tbl :: Table
tbl@Table {} = [Table] -> (Table -> LaTeXT m ()) -> LaTeXT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Table -> [Table]
splitTable Table
tbl) Table -> LaTeXT m ()
forall l. LaTeXC l => Table -> l
printTable'
  where
    printTable' :: Table -> l
printTable' (Table Row
headerInput [Row]
rowsInput)
      | Bool
tabX = l -> l
forall l. LaTeXC l => l -> l
center (l -> l) -> l -> l
forall a b. (a -> b) -> a -> b
$ Measure -> Maybe Pos -> [TableSpec] -> l -> l
forall l. LaTeXC l => Measure -> Maybe Pos -> [TableSpec] -> l -> l
tabularx (LaTeX -> Measure
CustomMeasure LaTeX
forall l. LaTeXC l => l
textwidth) Maybe Pos
forall a. Maybe a
Nothing (TableSpec
LeftColumn TableSpec -> [TableSpec] -> [TableSpec]
forall a. a -> [a] -> [a]
: Int -> TableSpec -> [TableSpec]
forall a. Int -> a -> [a]
replicate (Int
cols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (String -> TableSpec
NameColumn String
"X")) l
content
      | Bool
otherwise = l -> l
forall l. LaTeXC l => l -> l
center (l -> l) -> l -> l
forall a b. (a -> b) -> a -> b
$ Maybe Pos -> [TableSpec] -> l -> l
forall l. LaTeXC l => Maybe Pos -> [TableSpec] -> l -> l
tabular Maybe Pos
forall a. Maybe a
Nothing (Int -> TableSpec -> [TableSpec]
forall a. Int -> a -> [a]
replicate Int
cols TableSpec
LeftColumn) l
content
      where
        content :: l
content = l
forall l. LaTeXC l => l
hline l -> l -> l
forall a. Semigroup a => a -> a -> a
<> (l -> l) -> Row -> l
forall l. LaTeXC l => (l -> l) -> Row -> l
printRow l -> l
forall l. LaTeXC l => l -> l
textbf Row
header l -> l -> l
forall a. Semigroup a => a -> a -> a
<> l
forall l. LaTeXC l => l
hline l -> l -> l
forall a. Semigroup a => a -> a -> a
<> [l] -> l
forall a. Monoid a => [a] -> a
mconcat ((Row -> l) -> [Row] -> [l]
forall a b. (a -> b) -> [a] -> [b]
map ((l -> l) -> Row -> l
forall l. LaTeXC l => (l -> l) -> Row -> l
printRow l -> l
forall a. a -> a
id) [Row]
rows) l -> l -> l
forall a. Semigroup a => a -> a -> a
<> l
forall l. LaTeXC l => l
hline
        printRow :: (LaTeXC l) => (l -> l) -> Row -> l
        printRow :: (l -> l) -> Row -> l
printRow l -> l
_ (Row []) = l
forall a. Monoid a => a
mempty
        printRow l -> l
f (Row (Cell
c:[Cell]
cs)) = (l -> l -> l) -> l -> [l] -> l
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' l -> l -> l
forall l. LaTeXC l => l -> l -> l
(&) (l -> l
f (l -> l) -> l -> l
forall a b. (a -> b) -> a -> b
$ Cell -> l
forall l. LaTeXC l => Cell -> l
printCell Cell
c) ((Cell -> l) -> [Cell] -> [l]
forall a b. (a -> b) -> [a] -> [b]
map (l -> l
f (l -> l) -> (Cell -> l) -> Cell -> l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cell -> l
forall l. LaTeXC l => Cell -> l
printCell) [Cell]
cs) l -> l -> l
forall a. Semigroup a => a -> a -> a
<> l
forall l. LaTeXC l => l
lnbk
        printCell :: (LaTeXC l) => Cell -> l
        printCell :: Cell -> l
printCell (CellT Text
txt) = Text -> l
forall l. LaTeXC l => Text -> l
raw (Text -> Text
dereferLatex Text
txt)
        printCell (CellD Double
nr)  = Text -> l
forall l. LaTeXC l => Text -> l
raw (Text -> l) -> Text -> l
forall a b. (a -> b) -> a -> b
$ Double -> Text
printDouble Double
nr
        printCell (CellL LaTeX
l)   = LaTeX -> l
forall l. LaTeXC l => LaTeX -> l
fromLaTeX LaTeX
l
        printCell Cell
CellEmpty   = l
forall a. Monoid a => a
mempty
        cols :: Int
cols = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Row -> Int) -> [Row] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Row -> Int
cellCount (Row
headerInput Row -> [Row] -> [Row]
forall a. a -> [a] -> [a]
: [Row]
rowsInput)
        cellCount :: Row -> Int
cellCount (Row [Cell]
xs) = [Cell] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Cell]
xs
        extendRow :: Row -> Row
extendRow (Row [Cell]
xs) = [Cell] -> Row
Row ([Cell] -> Row) -> [Cell] -> Row
forall a b. (a -> b) -> a -> b
$ [Cell]
xs [Cell] -> [Cell] -> [Cell]
forall a. [a] -> [a] -> [a]
++ Int -> Cell -> [Cell]
forall a. Int -> a -> [a]
replicate (Int
cols Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Cell] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Cell]
xs) Cell
CellEmpty
        header :: Row
header = Row -> Row
extendRow Row
headerInput
        rows :: [Row]
rows = (Row -> Row) -> [Row] -> [Row]
forall a b. (a -> b) -> [a] -> [b]
map Row -> Row
extendRow [Row]
rowsInput

splitTable :: Table -> [Table]
splitTable :: Table -> [Table]
splitTable tbl :: Table
tbl@(Table Row
headerInput [Row]
rowsInput)
  | Int
colLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxColLen = [Table
tbl]
  | Bool
otherwise = Int -> Table -> Table
takeCols Int
maxColLen Table
tbl Table -> [Table] -> [Table]
forall a. a -> [a] -> [a]
: Table -> [Table]
splitTable (Int -> Table -> Table
dropCols Int
maxColLen Table
tbl)
  where
    colLen :: Int
colLen = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Row -> Int) -> [Row] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Row -> Int
cellCount (Row
headerInput Row -> [Row] -> [Row]
forall a. a -> [a] -> [a]
: [Row]
rowsInput)
    cellCount :: Row -> Int
cellCount (Row [Cell]
xs) = [Cell] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Cell]
xs
    takeCols :: Int -> Table -> Table
takeCols Int
n (Table (Row [Cell]
hs) [Row]
rs) = Row -> [Row] -> Table
Table ([Cell] -> Row
Row ([Cell] -> Row) -> [Cell] -> Row
forall a b. (a -> b) -> a -> b
$ Int -> [Cell] -> [Cell]
forall a. Int -> [a] -> [a]
take Int
n [Cell]
hs) ((Row -> Row) -> [Row] -> [Row]
forall a b. (a -> b) -> [a] -> [b]
map (\(Row [Cell]
r) -> [Cell] -> Row
Row (Int -> [Cell] -> [Cell]
forall a. Int -> [a] -> [a]
take Int
n [Cell]
r)) [Row]
rs)
    dropCols :: Int -> Table -> Table
dropCols Int
n (Table (Row [Cell]
hs) [Row]
rs) = Row -> [Row] -> Table
Table ([Cell] -> Row
Row ([Cell] -> Row) -> [Cell] -> Row
forall a b. (a -> b) -> a -> b
$ Int -> [Cell] -> [Cell]
forall a. Int -> [a] -> [a]
take Int
1 [Cell]
hs [Cell] -> [Cell] -> [Cell]
forall a. [a] -> [a] -> [a]
++ Int -> [Cell] -> [Cell]
forall a. Int -> [a] -> [a]
drop Int
n [Cell]
hs) ((Row -> Row) -> [Row] -> [Row]
forall a b. (a -> b) -> [a] -> [b]
map (\(Row [Cell]
r) -> [Cell] -> Row
Row (Int -> [Cell] -> [Cell]
forall a. Int -> [a] -> [a]
take Int
1 [Cell]
r [Cell] -> [Cell] -> [Cell]
forall a. [a] -> [a] -> [a]
++ Int -> [Cell] -> [Cell]
forall a. Int -> [a] -> [a]
drop Int
n [Cell]
r)) [Row]
rs)

maxColLen :: Int
maxColLen :: Int
maxColLen = Int
11

commas :: Int
commas :: Int
commas = Int
3

printDouble :: Double -> T.Text
printDouble :: Double -> Text
printDouble Double
x = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Double -> String
forall r. PrintfType r => String -> r
printf (String
"%." String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
commas String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"f") Double
x