{-# LANGUAGE FlexibleInstances #-}

-- |
-- Module      : OAlg.Control.Verbose
-- Description : verbosity on showing
-- Copyright   : (c) Erich Gut
-- License     : BSD3
-- Maintainer  : zerich.gut@gmail.com
--
-- verbosity on showing.
module OAlg.Control.Verbose
  (
    -- * Verbose
    Verbose(..), Verbosity(..)
  , vshowStr, mnString, vshowList, mnList

    -- * Percent
  , Percent(..), showPercent
  )
  where

import Control.Monad (join)

import OAlg.Data.Show

--------------------------------------------------------------------------------
-- Verbose -

-- | kinds of verbosity.
data Verbosity
  = Low | Middle | High | Full | Pretty deriving (Int -> Verbosity -> ShowS
[Verbosity] -> ShowS
Verbosity -> String
(Int -> Verbosity -> ShowS)
-> (Verbosity -> String)
-> ([Verbosity] -> ShowS)
-> Show Verbosity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Verbosity -> ShowS
showsPrec :: Int -> Verbosity -> ShowS
$cshow :: Verbosity -> String
show :: Verbosity -> String
$cshowList :: [Verbosity] -> ShowS
showList :: [Verbosity] -> ShowS
Show,Verbosity -> Verbosity -> Bool
(Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool) -> Eq Verbosity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Verbosity -> Verbosity -> Bool
== :: Verbosity -> Verbosity -> Bool
$c/= :: Verbosity -> Verbosity -> Bool
/= :: Verbosity -> Verbosity -> Bool
Eq,Eq Verbosity
Eq Verbosity =>
(Verbosity -> Verbosity -> Ordering)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Verbosity)
-> (Verbosity -> Verbosity -> Verbosity)
-> Ord Verbosity
Verbosity -> Verbosity -> Bool
Verbosity -> Verbosity -> Ordering
Verbosity -> Verbosity -> Verbosity
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Verbosity -> Verbosity -> Ordering
compare :: Verbosity -> Verbosity -> Ordering
$c< :: Verbosity -> Verbosity -> Bool
< :: Verbosity -> Verbosity -> Bool
$c<= :: Verbosity -> Verbosity -> Bool
<= :: Verbosity -> Verbosity -> Bool
$c> :: Verbosity -> Verbosity -> Bool
> :: Verbosity -> Verbosity -> Bool
$c>= :: Verbosity -> Verbosity -> Bool
>= :: Verbosity -> Verbosity -> Bool
$cmax :: Verbosity -> Verbosity -> Verbosity
max :: Verbosity -> Verbosity -> Verbosity
$cmin :: Verbosity -> Verbosity -> Verbosity
min :: Verbosity -> Verbosity -> Verbosity
Ord,Int -> Verbosity
Verbosity -> Int
Verbosity -> [Verbosity]
Verbosity -> Verbosity
Verbosity -> Verbosity -> [Verbosity]
Verbosity -> Verbosity -> Verbosity -> [Verbosity]
(Verbosity -> Verbosity)
-> (Verbosity -> Verbosity)
-> (Int -> Verbosity)
-> (Verbosity -> Int)
-> (Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> Verbosity -> [Verbosity])
-> Enum Verbosity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Verbosity -> Verbosity
succ :: Verbosity -> Verbosity
$cpred :: Verbosity -> Verbosity
pred :: Verbosity -> Verbosity
$ctoEnum :: Int -> Verbosity
toEnum :: Int -> Verbosity
$cfromEnum :: Verbosity -> Int
fromEnum :: Verbosity -> Int
$cenumFrom :: Verbosity -> [Verbosity]
enumFrom :: Verbosity -> [Verbosity]
$cenumFromThen :: Verbosity -> Verbosity -> [Verbosity]
enumFromThen :: Verbosity -> Verbosity -> [Verbosity]
$cenumFromTo :: Verbosity -> Verbosity -> [Verbosity]
enumFromTo :: Verbosity -> Verbosity -> [Verbosity]
$cenumFromThenTo :: Verbosity -> Verbosity -> Verbosity -> [Verbosity]
enumFromThenTo :: Verbosity -> Verbosity -> Verbosity -> [Verbosity]
Enum,Verbosity
Verbosity -> Verbosity -> Bounded Verbosity
forall a. a -> a -> Bounded a
$cminBound :: Verbosity
minBound :: Verbosity
$cmaxBound :: Verbosity
maxBound :: Verbosity
Bounded)

-- | shows @a@ in the context of verbosity.
class Show a => Verbose a where
  -- | the default implementation is: @vshow v a = vshowStr ('mnString' v) (show a)@
  vshow :: Verbosity -> a -> String
  vshow Verbosity
v a
a = Maybe Int -> ShowS
vshowStr (Verbosity -> Maybe Int
mnString Verbosity
v) (a -> String
forall a. Show a => a -> String
show a
a)

{-
mmax :: Maybe Int -> Int -> Maybe Int
mmax ma b = ma >>= \i -> return (max b i)
-}

--------------------------------------------------------------------------------
-- vshowStr -

-- | default length for a string representation in context of verbosity.
mnString :: Verbosity -> Maybe Int
mnString :: Verbosity -> Maybe Int
mnString Verbosity
Low    = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
10
mnString Verbosity
Middle = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
20
mnString Verbosity
High   = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
40
mnString Verbosity
_      = Maybe Int
forall a. Maybe a
Nothing

-- | verbosely showing a string by the given length.
--
-- __Example__
--
-- >>> vshowStr (Just 3) "123456789"
-- "123.."
--
-- >>> vshowStr Nothing "123456789"
-- "123456789"
vshowStr :: Maybe Int -> String -> String
vshowStr :: Maybe Int -> ShowS
vshowStr Maybe Int
mi String
str = case Maybe Int
mi of
    Just Int
n  -> String
str' String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall {a}. [a] -> String
dots String
r where (String
str',String
r) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n String
str
    Maybe Int
Nothing -> String
str
  where dots :: [a] -> String
dots [] = []
        dots [a]
_  = String
".."

--------------------------------------------------------------------------------
-- vshowList -

-- | default number of entries for a list representation in context of verbosity.
mnList :: Verbosity -> Maybe Int
mnList :: Verbosity -> Maybe Int
mnList Verbosity
Low    = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2
mnList Verbosity
Middle = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
10
mnList Verbosity
High   = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
100
mnList Verbosity
_      = Maybe Int
forall a. Maybe a
Nothing

-- | verbosely showing a list by the given length.
--
-- __Examples__
--
-- >>> vshowList Full (Just 3) "[" "]" "abcdef"
-- "['a','b','c'..]"
--
-- >>> vshowList Low (Just 3) "{" "}" ["abcdef","ghijklmn","op","qrst","uvwxyz"]
-- "{['a','b'..],['g','h'..],['o','p']..}"
vshowList :: Verbose a 
          => Verbosity
          -> Maybe Int
          -> String -> String
          -> [a]
          -> String
vshowList :: forall a.
Verbose a =>
Verbosity -> Maybe Int -> String -> String -> [a] -> String
vshowList Verbosity
v Maybe Int
mn String
db String
de [a]
xs
  = String
db String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Int -> [a] -> String
forall {a}. Verbose a => Maybe Int -> [a] -> String
vslst' Maybe Int
mn [a]
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
de
    where dots :: [a] -> String
dots [] = String
""
          dots [a]
_  = String
".."
          
          vslst' :: Maybe Int -> [a] -> String
vslst' Maybe Int
mn' [a]
xs' = case Maybe Int
mn' of
              Just Int
n  -> ([String] -> String
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
tween String
"," ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
ss') String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall {a}. [a] -> String
dots [String]
r where ([String]
ss',[String]
r) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [String]
ss
              Maybe Int
Nothing -> [String] -> String
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
tween String
"," ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
ss
            where ss :: [String]
ss = (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Verbosity -> a -> String
forall a. Verbose a => Verbosity -> a -> String
vshow Verbosity
v)  [a]
xs'

instance Verbose Char where
  vshow :: Verbosity -> Char -> String
vshow Verbosity
_ = Char -> String
forall a. Show a => a -> String
show

mnIntegrals :: Verbosity -> Maybe Int
mnIntegrals :: Verbosity -> Maybe Int
mnIntegrals Verbosity
Low    = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3
mnIntegrals Verbosity
Middle = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
5
mnIntegrals Verbosity
High   = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
7
mnIntegrals Verbosity
_      = Maybe Int
forall a. Maybe a
Nothing

----------------------------------------
-- Some instances -

instance Verbose Int where
  vshow :: Verbosity -> Int -> String
vshow Verbosity
v Int
n = Maybe Int -> ShowS
vshowStr (Verbosity -> Maybe Int
mnIntegrals Verbosity
v) (Int -> String
forall a. Show a => a -> String
show Int
n)

instance Verbose Integer where
  vshow :: Verbosity -> Integer -> String
vshow Verbosity
v Integer
n = Maybe Int -> ShowS
vshowStr (Verbosity -> Maybe Int
mnIntegrals Verbosity
v) (Integer -> String
forall a. Show a => a -> String
show Integer
n)

instance Verbose a => Verbose [a] where
  vshow :: Verbosity -> [a] -> String
vshow Verbosity
v = Verbosity -> Maybe Int -> String -> String -> [a] -> String
forall a.
Verbose a =>
Verbosity -> Maybe Int -> String -> String -> [a] -> String
vshowList Verbosity
v (Verbosity -> Maybe Int
mnList Verbosity
v) String
"[" String
"]"

instance Verbose Double

----------------------------------------
-- Verbose - Tuple -

vshowTuple :: [String] -> String
vshowTuple :: [String] -> String
vshowTuple [String]
ss = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ([String] -> String
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
tween String
"," [String]
ss) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

instance Verbose () where
  vshow :: Verbosity -> () -> String
vshow Verbosity
_ ()
_ = [String] -> String
vshowTuple []

instance (Verbose a,Verbose b) => Verbose (a,b) where
  vshow :: Verbosity -> (a, b) -> String
vshow Verbosity
v (a
a,b
b) = [String] -> String
vshowTuple [Verbosity -> a -> String
forall a. Verbose a => Verbosity -> a -> String
vshow Verbosity
v a
a,Verbosity -> b -> String
forall a. Verbose a => Verbosity -> a -> String
vshow Verbosity
v b
b]

instance (Verbose a,Verbose b,Verbose c) => Verbose (a,b,c) where
  vshow :: Verbosity -> (a, b, c) -> String
vshow Verbosity
v (a
a,b
b,c
c) = [String] -> String
vshowTuple [Verbosity -> a -> String
forall a. Verbose a => Verbosity -> a -> String
vshow Verbosity
v a
a,Verbosity -> b -> String
forall a. Verbose a => Verbosity -> a -> String
vshow Verbosity
v b
b,Verbosity -> c -> String
forall a. Verbose a => Verbosity -> a -> String
vshow Verbosity
v c
c]

instance (Verbose a,Verbose b,Verbose c,Verbose d) => Verbose (a,b,c,d) where
  vshow :: Verbosity -> (a, b, c, d) -> String
vshow Verbosity
v (a
a,b
b,c
c,d
d) = [String] -> String
vshowTuple [Verbosity -> a -> String
forall a. Verbose a => Verbosity -> a -> String
vshow Verbosity
v a
a,Verbosity -> b -> String
forall a. Verbose a => Verbosity -> a -> String
vshow Verbosity
v b
b,Verbosity -> c -> String
forall a. Verbose a => Verbosity -> a -> String
vshow Verbosity
v c
c,Verbosity -> d -> String
forall a. Verbose a => Verbosity -> a -> String
vshow Verbosity
v d
d]

instance (Verbose a,Verbose b,Verbose c,Verbose d, Verbose e) => Verbose (a,b,c,d,e) where
  vshow :: Verbosity -> (a, b, c, d, e) -> String
vshow Verbosity
v (a
a,b
b,c
c,d
d,e
e) = [String] -> String
vshowTuple [Verbosity -> a -> String
forall a. Verbose a => Verbosity -> a -> String
vshow Verbosity
v a
a,Verbosity -> b -> String
forall a. Verbose a => Verbosity -> a -> String
vshow Verbosity
v b
b,Verbosity -> c -> String
forall a. Verbose a => Verbosity -> a -> String
vshow Verbosity
v c
c,Verbosity -> d -> String
forall a. Verbose a => Verbosity -> a -> String
vshow Verbosity
v d
d,Verbosity -> e -> String
forall a. Verbose a => Verbosity -> a -> String
vshow Verbosity
v e
e]

instance (Verbose a,Verbose b,Verbose c,Verbose d, Verbose e,Verbose f)
  => Verbose (a,b,c,d,e,f) where
  vshow :: Verbosity -> (a, b, c, d, e, f) -> String
vshow Verbosity
v (a
a,b
b,c
c,d
d,e
e,f
f)
    = [String] -> String
vshowTuple [Verbosity -> a -> String
forall a. Verbose a => Verbosity -> a -> String
vshow Verbosity
v a
a,Verbosity -> b -> String
forall a. Verbose a => Verbosity -> a -> String
vshow Verbosity
v b
b,Verbosity -> c -> String
forall a. Verbose a => Verbosity -> a -> String
vshow Verbosity
v c
c,Verbosity -> d -> String
forall a. Verbose a => Verbosity -> a -> String
vshow Verbosity
v d
d,Verbosity -> e -> String
forall a. Verbose a => Verbosity -> a -> String
vshow Verbosity
v e
e,Verbosity -> f -> String
forall a. Verbose a => Verbosity -> a -> String
vshow Verbosity
v f
f]


--------------------------------------------------------------------------------
-- Percent -

-- | tagging for showing percentage of a 'Double'.
newtype Percent x = Percent x deriving Int -> Percent x -> ShowS
[Percent x] -> ShowS
Percent x -> String
(Int -> Percent x -> ShowS)
-> (Percent x -> String)
-> ([Percent x] -> ShowS)
-> Show (Percent x)
forall x. Show x => Int -> Percent x -> ShowS
forall x. Show x => [Percent x] -> ShowS
forall x. Show x => Percent x -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall x. Show x => Int -> Percent x -> ShowS
showsPrec :: Int -> Percent x -> ShowS
$cshow :: forall x. Show x => Percent x -> String
show :: Percent x -> String
$cshowList :: forall x. Show x => [Percent x] -> ShowS
showList :: [Percent x] -> ShowS
Show

nPercent :: Verbosity -> Int
nPercent :: Verbosity -> Int
nPercent Verbosity
Low    = Int
0
nPercent Verbosity
Middle = Int
2
nPercent Verbosity
_      = Int
4

instance Verbose (Percent Double) where
  vshow :: Verbosity -> Percent Double -> String
vshow Verbosity
v (Percent Double
x) = Int -> Double -> String
showPercent (Verbosity -> Int
nPercent Verbosity
v) Double
x

--------------------------------------------------------------------------------
-- showPercent -

-- | showing a double as percent with the given precision.
--
-- __Example__
--
-- >>> showPercent 2 0.912837
-- " 91.28%"
showPercent :: Int -> Double -> String
showPercent :: Int -> Double -> String
showPercent Int
n Double
d = String
sprc String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n then String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sprm else String
"") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"%"
  where n' :: Double
n'        = Double
10 Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Int -> Double
forall a. Enum a => Int -> a
toEnum Int
n
        (Integer
prc,Double
prm) = (Double -> (Integer, Double)
forall b. Integral b => Double -> (b, Double)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction :: Double -> (Integer,Double))
                    ((Int -> Double
forall a. Enum a => Int -> a
toEnum (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ (Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
n' Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
d)) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
n')
        sprc' :: String
sprc'     = Integer -> String
forall a. Show a => a -> String
show Integer
prc
        sprc :: String
sprc      = let dgs :: Int
dgs = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
sprc' in (Int -> ShowS
forall a. Int -> [a] -> [a]
take (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dgs) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Char -> String
forall a. a -> [a]
repeat (Char -> String) -> Char -> String
forall a b. (a -> b) -> a -> b
$ Char
' ') String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sprc'

        sprm' :: String
sprm'     = (Integer -> String
forall a. Show a => a -> String
show :: Integer -> String) (Integer -> String) -> Integer -> String
forall a b. (a -> b) -> a -> b
$ Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Integer) -> Double -> Integer
forall a b. (a -> b) -> a -> b
$ (Double
n' Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
prm)
        sprm :: String
sprm      = let dgs :: Int
dgs = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
sprm' in String
sprm' String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> ShowS
forall a. Int -> [a] -> [a]
take (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dgs) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Char -> String
forall a. a -> [a]
repeat (Char -> String) -> Char -> String
forall a b. (a -> b) -> a -> b
$ Char
'0')