{-# 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
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
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. 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: Table -> ()
$crnf :: Table -> ()
NFData)

newtype Row =
  Row [Cell]
  deriving (Int -> Row -> ShowS
[Row] -> ShowS
Row -> String
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
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. 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 -> ()
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
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
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. 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)  = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

dereferLatex :: T.Text -> T.Text
dereferLatex :: Text -> Text
dereferLatex Text
x = Text -> Text
protectText forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Text
x' (Text
f, Text
t) -> Text -> Text -> Text -> Text
T.replace Text
f Text
t Text
x') Text
x [(Text, Text)]
list
  where
    list :: [(T.Text, T.Text)]
    list :: [(Text, Text)]
list = [(Text
"{", Text
"\\{"), (Text
"}", Text
"\\}"), (Text
"_", Text
"\\_"), (Text
"_", Text
"\\_"), (Text
"%", Text
"\\%"), (Text
"^", Text
"\\^"), (Text
"~", Text
"\\~"), (Text
"$", Text
"\\$")]

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

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


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