module Util.Table
( Tables, tables, tableList
, Table
, Count
, count, percentage
) where
import Data.Semigroup
import qualified Data.Map as M
newtype Count = C Int
instance Show Count where
show (C n) = show n
instance Semigroup Count where
C x <> C y = C (x + y)
instance Monoid Count where
mempty = C 0
mappend = (<>)
data Percentage = P Int Int
instance Show Percentage where
show (P x y) = show x ++ " (" ++ showAsPerc (fromIntegral x / fromIntegral y) ++ ")"
count :: String -> String -> Tables Count
count t s = tables (one' t s)
one' :: String -> String -> Table Count
one' t s = Table t (TD (M.singleton s (C 1)))
percentage :: Tables Count -> Tables Percentage
percentage (Tables m) = Tables (M.map perc m)
perc :: TableData Count -> TableData Percentage
perc (TD m) = TD (M.map g m)
where
C y = mconcat (M.elems m)
g (C x) = P x y
newtype Tables a = Tables (M.Map String (TableData a))
instance Show a => Show (Tables a) where
show = unlines . map show . tableList
instance Semigroup a => Semigroup (Tables a) where
Tables m1 <> Tables m2 = Tables (M.unionWith (<>) m1 m2)
instance Semigroup a => Monoid (Tables a) where
mempty = Tables mempty
mappend = (<>)
tableList :: Tables a -> [Table a]
tableList (Tables m) = map (uncurry Table) (M.toList m)
tables :: Table a -> Tables a
tables t = Tables (M.singleton (title t) (tableData t))
data Table a = Table { title :: String, tableData :: TableData a }
instance Show a => Show (Table a) where
show t = title t ++ "\n" ++ show (tableData t)
newtype TableData a = TD (M.Map String a)
instance Show a => Show (TableData a) where
show (TD m) = unlines (line : zipWith colon (map (ljustify lx) xs) ys)
where
colon x y = x ++ " : " ++ y
line = replicate (lx + ly + 3) '-'
xs = M.keys m
ys = map show (M.elems m)
lx = maximum (0 : map length xs)
ly = maximum (0 : map length ys)
instance Semigroup a => Semigroup (TableData a) where
TD m1 <> TD m2 = TD (M.unionWith (<>) m1 m2)
instance Semigroup a => Monoid (TableData a) where
mempty = TD mempty
mappend = (<>)
ljustify :: Int -> String -> String
ljustify n s = take n (s ++ repeat ' ' )
showAsPerc :: Rational -> String
showAsPerc r = show d ++ "." ++ show m ++ "%"
where
n = round (r * 1000) :: Int
(d, m) = n `divMod` 10