{-# 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