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