-----------------------------------------------------------------------------
-- Copyright 2019, Advise-Me project team. This file is distributed under 
-- the terms of the Apache License 2.0. For more information, see the files
-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
-----------------------------------------------------------------------------
-- |
-- Maintainer  :  bastiaan.heeren@ou.nl
-- Stability   :  provisional
-- Portability :  portable (depends on ghc)
--
-----------------------------------------------------------------------------

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