{-#LANGUAGE RecordWildCards#-}

------------------------------------------------------------------------------
-- |
-- Module: Xmobar.Plugins.Monitors.Strings
-- Copyright: (c) 2018, 2019, 2020 Jose Antonio Ortega Ruiz
-- License: BSD3-style (see LICENSE)
--
-- Maintainer: jao@gnu.org
-- Stability: unstable
-- Portability: portable
-- Created: Sun Dec 02, 2018 04:25
--
--
-- Utilities for formatting monitor outputs
--
------------------------------------------------------------------------------


module Xmobar.Plugins.Monitors.Common.Output ( IconPattern
                                             , parseIconPattern
                                             , padString
                                             , colorizeString
                                             , showWithPadding
                                             , showWithColors
                                             , showWithColors'
                                             , showPercentWithColors
                                             , showPercentsWithColors
                                             , showPercentBar
                                             , showVerticalBar
                                             , showIconPattern
                                             , showLogBar
                                             , showLogVBar
                                             , showLogIconPattern
                                             , showWithUnits
                                             , takeDigits
                                             , showDigits
                                             , floatToPercent
                                             , parseFloat
                                             , parseInt
                                             , stringParser
                                             , pShowPercentsWithColors
                                             , pShowPercentBar
                                             , pShowVerticalBar
                                             , pShowIconPattern
                                             , pShowPercentWithColors
                                             ) where

import Data.Char
import Data.List (intercalate, sort)
import qualified Data.ByteString.Lazy.Char8 as B
import Numeric
import Control.Monad (zipWithM)
import Control.Monad.IO.Class (MonadIO(..))
import Xmobar.Plugins.Monitors.Common.Types

type IconPattern = Int -> String

pShowVerticalBar :: (MonadIO m) => MonitorConfig -> Float -> Float -> m String
pShowVerticalBar :: MonitorConfig -> Float -> Float -> m String
pShowVerticalBar MonitorConfig
p Float
v Float
x = MonitorConfig -> Float -> String -> m String
forall a (m :: * -> *).
(Num a, Ord a, MonadIO m) =>
MonitorConfig -> a -> String -> m String
pColorizeString MonitorConfig
p Float
v [Float -> Char
convert (Float -> Char) -> Float -> Char
forall a b. (a -> b) -> a -> b
$ Float
100 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x]
  where convert :: Float -> Char
        convert :: Float -> Char
convert Float
val
          | Int
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9600 = Char
' '
          | Int
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
9608 = Int -> Char
chr Int
9608
          | Bool
otherwise = Int -> Char
chr Int
t
          where t :: Int
t = Int
9600 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Float
val Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
12)

pShowPercentsWithColors :: (MonadIO m) => MonitorConfig -> [Float] -> m [String]
pShowPercentsWithColors :: MonitorConfig -> [Float] -> m [String]
pShowPercentsWithColors MonitorConfig
p [Float]
fs =
  do let fstrs :: [String]
fstrs = (Float -> String) -> [Float] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (MonitorConfig -> Float -> String
pFloatToPercent MonitorConfig
p) [Float]
fs
         temp :: [Float]
temp = (Float -> Float) -> [Float] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
100) [Float]
fs
     (String -> Float -> m String) -> [String] -> [Float] -> m [String]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (MonitorConfig -> (Float -> String) -> Float -> m String
forall a (m :: * -> *).
(Num a, Ord a, MonadIO m) =>
MonitorConfig -> (a -> String) -> a -> m String
pShowWithColors MonitorConfig
p ((Float -> String) -> Float -> m String)
-> (String -> Float -> String) -> String -> Float -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Float -> String
forall a b. a -> b -> a
const) [String]
fstrs [Float]
temp

pShowPercentWithColors :: (MonadIO m) => MonitorConfig -> Float -> m String
pShowPercentWithColors :: MonitorConfig -> Float -> m String
pShowPercentWithColors MonitorConfig
p Float
f = ([String] -> String) -> m [String] -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> String
forall a. [a] -> a
head (m [String] -> m String) -> m [String] -> m String
forall a b. (a -> b) -> a -> b
$ MonitorConfig -> [Float] -> m [String]
forall (m :: * -> *).
MonadIO m =>
MonitorConfig -> [Float] -> m [String]
pShowPercentsWithColors MonitorConfig
p [Float
f]

pShowPercentBar :: (MonadIO m) => MonitorConfig -> Float -> Float -> m String
pShowPercentBar :: MonitorConfig -> Float -> Float -> m String
pShowPercentBar p :: MonitorConfig
p@MonitorConfig{Bool
Int
String
[String]
Maybe String
pMaxTotalWidthEllipsis :: MonitorConfig -> String
pMaxTotalWidth :: MonitorConfig -> Int
pNaString :: MonitorConfig -> String
pUseSuffix :: MonitorConfig -> Bool
pBarWidth :: MonitorConfig -> Int
pBarFore :: MonitorConfig -> String
pBarBack :: MonitorConfig -> String
pPadRight :: MonitorConfig -> Bool
pPadChars :: MonitorConfig -> String
pMaxWidthEllipsis :: MonitorConfig -> String
pMaxWidth :: MonitorConfig -> Int
pMinWidth :: MonitorConfig -> Int
pDecDigits :: MonitorConfig -> Int
pPpad :: MonitorConfig -> Int
pExport :: MonitorConfig -> [String]
pTemplate :: MonitorConfig -> String
pHighColor :: MonitorConfig -> Maybe String
pHigh :: MonitorConfig -> Int
pLowColor :: MonitorConfig -> Maybe String
pLow :: MonitorConfig -> Int
pNormalColor :: MonitorConfig -> Maybe String
pMaxTotalWidthEllipsis :: String
pMaxTotalWidth :: Int
pNaString :: String
pUseSuffix :: Bool
pBarWidth :: Int
pBarFore :: String
pBarBack :: String
pPadRight :: Bool
pPadChars :: String
pMaxWidthEllipsis :: String
pMaxWidth :: Int
pMinWidth :: Int
pDecDigits :: Int
pPpad :: Int
pExport :: [String]
pTemplate :: String
pHighColor :: Maybe String
pHigh :: Int
pLowColor :: Maybe String
pLow :: Int
pNormalColor :: Maybe String
..} Float
v Float
x = do
  let len :: Int
len = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
pBarWidth (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pBarWidth Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x)
  String
s <- MonitorConfig -> Float -> String -> m String
forall a (m :: * -> *).
(Num a, Ord a, MonadIO m) =>
MonitorConfig -> a -> String -> m String
pColorizeString MonitorConfig
p Float
v (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
len (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
cycle String
pBarFore)
  String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall a. Int -> [a] -> [a]
take (Int
pBarWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) (String -> String
forall a. [a] -> [a]
cycle String
pBarBack)

pShowWithColors :: (Num a, Ord a, MonadIO m) => MonitorConfig -> (a -> String) -> a -> m String
pShowWithColors :: MonitorConfig -> (a -> String) -> a -> m String
pShowWithColors MonitorConfig
p a -> String
f a
x = do
  let str :: String
str = MonitorConfig -> String -> String
pShowWithPadding MonitorConfig
p (a -> String
f a
x)
  MonitorConfig -> a -> String -> m String
forall a (m :: * -> *).
(Num a, Ord a, MonadIO m) =>
MonitorConfig -> a -> String -> m String
pColorizeString MonitorConfig
p a
x String
str

pColorizeString :: (Num a, Ord a, MonadIO m) => MonitorConfig -> a -> String -> m String
pColorizeString :: MonitorConfig -> a -> String -> m String
pColorizeString MonitorConfig
p a
x String
s = do
    let col :: (MonitorConfig -> Maybe String) -> String
col = MonitorConfig
-> String -> (MonitorConfig -> Maybe String) -> String
pSetColor MonitorConfig
p String
s
        [a
ll,a
hh] = (Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [a]) -> [Int] -> [a]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort [MonitorConfig -> Int
pLow MonitorConfig
p, MonitorConfig -> Int
pHigh MonitorConfig
p] -- consider high < low
    String -> m String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [(MonitorConfig -> Maybe String) -> String
col MonitorConfig -> Maybe String
pHighColor   | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
hh ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                  [(MonitorConfig -> Maybe String) -> String
col MonitorConfig -> Maybe String
pNormalColor | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
ll ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                  [(MonitorConfig -> Maybe String) -> String
col MonitorConfig -> Maybe String
pLowColor    | Bool
True]

pSetColor :: MonitorConfig -> String -> PSelector (Maybe String) -> String
pSetColor :: MonitorConfig
-> String -> (MonitorConfig -> Maybe String) -> String
pSetColor MonitorConfig
config String
str MonitorConfig -> Maybe String
s =
    do let a :: Maybe String
a = MonitorConfig -> (MonitorConfig -> Maybe String) -> Maybe String
forall a. MonitorConfig -> PSelector a -> a
getPConfigValue MonitorConfig
config MonitorConfig -> Maybe String
s
       case Maybe String
a of
            Maybe String
Nothing -> String
str
            Just String
c -> String
"<fc=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</fc>"

pShowWithPadding :: MonitorConfig -> String -> String
pShowWithPadding :: MonitorConfig -> String -> String
pShowWithPadding MonitorConfig {Bool
Int
String
[String]
Maybe String
pMaxTotalWidthEllipsis :: String
pMaxTotalWidth :: Int
pNaString :: String
pUseSuffix :: Bool
pBarWidth :: Int
pBarFore :: String
pBarBack :: String
pPadRight :: Bool
pPadChars :: String
pMaxWidthEllipsis :: String
pMaxWidth :: Int
pMinWidth :: Int
pDecDigits :: Int
pPpad :: Int
pExport :: [String]
pTemplate :: String
pHighColor :: Maybe String
pHigh :: Int
pLowColor :: Maybe String
pLow :: Int
pNormalColor :: Maybe String
pMaxTotalWidthEllipsis :: MonitorConfig -> String
pMaxTotalWidth :: MonitorConfig -> Int
pNaString :: MonitorConfig -> String
pUseSuffix :: MonitorConfig -> Bool
pBarWidth :: MonitorConfig -> Int
pBarFore :: MonitorConfig -> String
pBarBack :: MonitorConfig -> String
pPadRight :: MonitorConfig -> Bool
pPadChars :: MonitorConfig -> String
pMaxWidthEllipsis :: MonitorConfig -> String
pMaxWidth :: MonitorConfig -> Int
pMinWidth :: MonitorConfig -> Int
pDecDigits :: MonitorConfig -> Int
pPpad :: MonitorConfig -> Int
pExport :: MonitorConfig -> [String]
pTemplate :: MonitorConfig -> String
pHighColor :: MonitorConfig -> Maybe String
pHigh :: MonitorConfig -> Int
pLowColor :: MonitorConfig -> Maybe String
pLow :: MonitorConfig -> Int
pNormalColor :: MonitorConfig -> Maybe String
..} =
  Int -> Int -> String -> Bool -> String -> String -> String
padString Int
pMinWidth Int
pMaxWidth String
pPadChars Bool
pPadRight String
pMaxWidthEllipsis

pFloatToPercent :: MonitorConfig -> Float -> String
pFloatToPercent :: MonitorConfig -> Float -> String
pFloatToPercent MonitorConfig{Bool
Int
String
[String]
Maybe String
pMaxTotalWidthEllipsis :: String
pMaxTotalWidth :: Int
pNaString :: String
pUseSuffix :: Bool
pBarWidth :: Int
pBarFore :: String
pBarBack :: String
pPadRight :: Bool
pPadChars :: String
pMaxWidthEllipsis :: String
pMaxWidth :: Int
pMinWidth :: Int
pDecDigits :: Int
pPpad :: Int
pExport :: [String]
pTemplate :: String
pHighColor :: Maybe String
pHigh :: Int
pLowColor :: Maybe String
pLow :: Int
pNormalColor :: Maybe String
pMaxTotalWidthEllipsis :: MonitorConfig -> String
pMaxTotalWidth :: MonitorConfig -> Int
pNaString :: MonitorConfig -> String
pUseSuffix :: MonitorConfig -> Bool
pBarWidth :: MonitorConfig -> Int
pBarFore :: MonitorConfig -> String
pBarBack :: MonitorConfig -> String
pPadRight :: MonitorConfig -> Bool
pPadChars :: MonitorConfig -> String
pMaxWidthEllipsis :: MonitorConfig -> String
pMaxWidth :: MonitorConfig -> Int
pMinWidth :: MonitorConfig -> Int
pDecDigits :: MonitorConfig -> Int
pPpad :: MonitorConfig -> Int
pExport :: MonitorConfig -> [String]
pTemplate :: MonitorConfig -> String
pHighColor :: MonitorConfig -> Maybe String
pHigh :: MonitorConfig -> Int
pLowColor :: MonitorConfig -> Maybe String
pLow :: MonitorConfig -> Int
pNormalColor :: MonitorConfig -> Maybe String
..} Float
n = let p :: String
p = Int -> Float -> String
forall a. RealFloat a => Int -> a -> String
showDigits Int
0 (Float
n Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
100)
                                          ps :: String
ps = if Bool
pUseSuffix then String
"%" else String
""
                                      in Int -> Int -> String -> Bool -> String -> String -> String
padString Int
pPpad Int
pPpad String
pPadChars Bool
pPadRight String
"" String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ps

parseIconPattern :: String -> IconPattern
parseIconPattern :: String -> IconPattern
parseIconPattern String
path =
    let spl :: [String]
spl = String -> [String]
splitOnPercent String
path
    in \Int
i -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate (IconPattern
forall a. Show a => a -> String
show Int
i) [String]
spl
  where splitOnPercent :: String -> [String]
splitOnPercent [] = [[]]
        splitOnPercent (Char
'%':Char
'%':String
xs) = [] String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
splitOnPercent String
xs
        splitOnPercent (Char
x:String
xs) =
            let rest :: [String]
rest = String -> [String]
splitOnPercent String
xs
            in (Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: [String] -> String
forall a. [a] -> a
head [String]
rest) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
forall a. [a] -> [a]
tail [String]
rest

type Pos = (Int, Int)

takeDigits :: Int -> Float -> Float
takeDigits :: Int -> Float -> Float
takeDigits Int
d Float
n =
    Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Float
n Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
fact) :: Int) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
fact
  where fact :: Float
fact = Float
10 Float -> Int -> Float
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
d

showDigits :: (RealFloat a) => Int -> a -> String
showDigits :: Int -> a -> String
showDigits Int
d a
n = Maybe Int -> a -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
d) a
n String
""

showWithUnits :: Int -> Int -> Float -> String
showWithUnits :: Int -> Int -> Float -> String
showWithUnits Int
d Int
n Float
x
  | Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0 = Char
'-' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> Int -> Float -> String
showWithUnits Int
d Int
n (-Float
x)
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
3 Bool -> Bool -> Bool
|| Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
10Float -> Int -> Float
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) = IconPattern
forall a. Show a => a -> String
show (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Float
x :: Int) String -> String -> String
forall a. [a] -> [a] -> [a]
++ IconPattern
units Int
n
  | Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
1024 = Int -> Float -> String
forall a. RealFloat a => Int -> a -> String
showDigits Int
d (Float
xFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
1024) String -> String -> String
forall a. [a] -> [a] -> [a]
++ IconPattern
units (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
  | Bool
otherwise = Int -> Int -> Float -> String
showWithUnits Int
d (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Float
xFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
1024)
  where units :: IconPattern
units = [String] -> IconPattern
forall a. [a] -> Int -> a
(!!) [String
"B", String
"K", String
"M", String
"G", String
"T"]

padString :: Int -> Int -> String -> Bool -> String -> String -> String
padString :: Int -> Int -> String -> Bool -> String -> String -> String
padString Int
mnw Int
mxw String
pad Bool
pr String
ellipsis String
s =
  let len :: Int
len = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s
      rmin :: Int
rmin = if Int
mnw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Int
0 else Int
mnw
      rmax :: Int
rmax = if Int
mxw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 then Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
len Int
rmin else Int
mxw
      (Int
rmn, Int
rmx) = if Int
rmin Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
rmax then (Int
rmin, Int
rmax) else (Int
rmax, Int
rmin)
      rlen :: Int
rlen = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
rmn Int
len) Int
rmx
  in if Int
rlen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len then
       Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
rlen String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ellipsis
     else let ps :: String
ps = Int -> String -> String
forall a. Int -> [a] -> [a]
take (Int
rlen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) (String -> String
forall a. [a] -> [a]
cycle String
pad)
          in if Bool
pr then String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ps else String
ps String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s

parseFloat :: String -> Float
parseFloat :: String -> Float
parseFloat String
s = case ReadS Float
forall a. RealFrac a => ReadS a
readFloat String
s of
  (Float
v, String
_):[(Float, String)]
_ -> Float
v
  [(Float, String)]
_ -> Float
0

parseInt :: String -> Int
parseInt :: String -> Int
parseInt String
s = case ReadS Int
forall a. (Eq a, Num a) => ReadS a
readDec String
s of
  (Int
v, String
_):[(Int, String)]
_ -> Int
v
  [(Int, String)]
_ -> Int
0

floatToPercent :: Float -> Monitor String
floatToPercent :: Float -> Monitor String
floatToPercent Float
n =
  do Int
pad <- Selector Int -> Monitor Int
forall a. Selector a -> Monitor a
getConfigValue Selector Int
ppad
     String
pc <- Selector String -> Monitor String
forall a. Selector a -> Monitor a
getConfigValue Selector String
padChars
     Bool
pr <- Selector Bool -> Monitor Bool
forall a. Selector a -> Monitor a
getConfigValue Selector Bool
padRight
     Bool
up <- Selector Bool -> Monitor Bool
forall a. Selector a -> Monitor a
getConfigValue Selector Bool
useSuffix
     let p :: String
p = Int -> Float -> String
forall a. RealFloat a => Int -> a -> String
showDigits Int
0 (Float
n Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
100)
         ps :: String
ps = if Bool
up then String
"%" else String
""
     String -> Monitor String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Monitor String) -> String -> Monitor String
forall a b. (a -> b) -> a -> b
$ Int -> Int -> String -> Bool -> String -> String -> String
padString Int
pad Int
pad String
pc Bool
pr String
"" String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ps

stringParser :: Pos -> B.ByteString -> String
stringParser :: (Int, Int) -> ByteString -> String
stringParser (Int
x,Int
y) =
     ByteString -> String
B.unpack (ByteString -> String)
-> (ByteString -> ByteString) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [ByteString] -> ByteString
li Int
x ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
B.words (ByteString -> [ByteString])
-> (ByteString -> ByteString) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [ByteString] -> ByteString
li Int
y ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
B.lines
    where li :: Int -> [ByteString] -> ByteString
li Int
i [ByteString]
l | [ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
i = [ByteString]
l [ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!! Int
i
                 | Bool
otherwise    = ByteString
B.empty

setColor :: String -> Selector (Maybe String) -> Monitor String
setColor :: String -> Selector (Maybe String) -> Monitor String
setColor String
str Selector (Maybe String)
s =
    do Maybe String
a <- Selector (Maybe String) -> Monitor (Maybe String)
forall a. Selector a -> Monitor a
getConfigValue Selector (Maybe String)
s
       case Maybe String
a of
            Maybe String
Nothing -> String -> Monitor String
forall (m :: * -> *) a. Monad m => a -> m a
return String
str
            Just String
c -> String -> Monitor String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Monitor String) -> String -> Monitor String
forall a b. (a -> b) -> a -> b
$
                String
"<fc=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</fc>"

showWithPadding :: String -> Monitor String
showWithPadding :: String -> Monitor String
showWithPadding String
s =
    do Int
mn <- Selector Int -> Monitor Int
forall a. Selector a -> Monitor a
getConfigValue Selector Int
minWidth
       Int
mx <- Selector Int -> Monitor Int
forall a. Selector a -> Monitor a
getConfigValue Selector Int
maxWidth
       String
p <- Selector String -> Monitor String
forall a. Selector a -> Monitor a
getConfigValue Selector String
padChars
       Bool
pr <- Selector Bool -> Monitor Bool
forall a. Selector a -> Monitor a
getConfigValue Selector Bool
padRight
       String
ellipsis <- Selector String -> Monitor String
forall a. Selector a -> Monitor a
getConfigValue Selector String
maxWidthEllipsis
       String -> Monitor String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Monitor String) -> String -> Monitor String
forall a b. (a -> b) -> a -> b
$ Int -> Int -> String -> Bool -> String -> String -> String
padString Int
mn Int
mx String
p Bool
pr String
ellipsis String
s

colorizeString :: (Num a, Ord a) => a -> String -> Monitor String
colorizeString :: a -> String -> Monitor String
colorizeString a
x String
s = do
    Int
h <- Selector Int -> Monitor Int
forall a. Selector a -> Monitor a
getConfigValue Selector Int
high
    Int
l <- Selector Int -> Monitor Int
forall a. Selector a -> Monitor a
getConfigValue Selector Int
low
    let col :: Selector (Maybe String) -> Monitor String
col = String -> Selector (Maybe String) -> Monitor String
setColor String
s
        [a
ll,a
hh] = (Int -> a) -> [Int] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [a]) -> [Int] -> [a]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort [Int
l, Int
h] -- consider high < low
    [Monitor String] -> Monitor String
forall a. [a] -> a
head ([Monitor String] -> Monitor String)
-> [Monitor String] -> Monitor String
forall a b. (a -> b) -> a -> b
$ [Selector (Maybe String) -> Monitor String
col Selector (Maybe String)
highColor   | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
hh ] [Monitor String] -> [Monitor String] -> [Monitor String]
forall a. [a] -> [a] -> [a]
++
           [Selector (Maybe String) -> Monitor String
col Selector (Maybe String)
normalColor | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
ll ] [Monitor String] -> [Monitor String] -> [Monitor String]
forall a. [a] -> [a] -> [a]
++
           [Selector (Maybe String) -> Monitor String
col Selector (Maybe String)
lowColor    | Bool
True]

showWithColors :: (Num a, Ord a) => (a -> String) -> a -> Monitor String
showWithColors :: (a -> String) -> a -> Monitor String
showWithColors a -> String
f a
x = String -> Monitor String
showWithPadding (a -> String
f a
x) Monitor String -> (String -> Monitor String) -> Monitor String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> String -> Monitor String
forall a. (Num a, Ord a) => a -> String -> Monitor String
colorizeString a
x

showWithColors' :: (Num a, Ord a) => String -> a -> Monitor String
showWithColors' :: String -> a -> Monitor String
showWithColors' String
str = (a -> String) -> a -> Monitor String
forall a. (Num a, Ord a) => (a -> String) -> a -> Monitor String
showWithColors (String -> a -> String
forall a b. a -> b -> a
const String
str)

showPercentsWithColors :: [Float] -> Monitor [String]
showPercentsWithColors :: [Float] -> Monitor [String]
showPercentsWithColors [Float]
fs =
  do [String]
fstrs <- (Float -> Monitor String) -> [Float] -> Monitor [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Float -> Monitor String
floatToPercent [Float]
fs
     (String -> Float -> Monitor String)
-> [String] -> [Float] -> Monitor [String]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM ((Float -> String) -> Float -> Monitor String
forall a. (Num a, Ord a) => (a -> String) -> a -> Monitor String
showWithColors ((Float -> String) -> Float -> Monitor String)
-> (String -> Float -> String) -> String -> Float -> Monitor String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Float -> String
forall a b. a -> b -> a
const) [String]
fstrs ((Float -> Float) -> [Float] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
100) [Float]
fs)

showPercentWithColors :: Float -> Monitor String
showPercentWithColors :: Float -> Monitor String
showPercentWithColors Float
f = ([String] -> String) -> Monitor [String] -> Monitor String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> String
forall a. [a] -> a
head (Monitor [String] -> Monitor String)
-> Monitor [String] -> Monitor String
forall a b. (a -> b) -> a -> b
$ [Float] -> Monitor [String]
showPercentsWithColors [Float
f]

showPercentBar :: Float -> Float -> Monitor String
showPercentBar :: Float -> Float -> Monitor String
showPercentBar Float
v Float
x = do
  String
bb <- Selector String -> Monitor String
forall a. Selector a -> Monitor a
getConfigValue Selector String
barBack
  String
bf <- Selector String -> Monitor String
forall a. Selector a -> Monitor a
getConfigValue Selector String
barFore
  Int
bw <- Selector Int -> Monitor Int
forall a. Selector a -> Monitor a
getConfigValue Selector Int
barWidth
  let c :: Bool
c = Int
bw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1
      w :: Int
w = if Bool
c then String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
bf else Int
bw
      len :: Int
len = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
w (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x)
      bfs :: String
bfs = if Bool
c then [String
bf String -> Int -> Char
forall a. [a] -> Int -> a
!! Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)] else Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
len (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
cycle String
bf
  String
s <- Float -> String -> Monitor String
forall a. (Num a, Ord a) => a -> String -> Monitor String
colorizeString Float
v String
bfs
  String -> Monitor String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Monitor String) -> String -> Monitor String
forall a b. (a -> b) -> a -> b
$ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ if Bool
c then String
"" else Int -> String -> String
forall a. Int -> [a] -> [a]
take (Int
bw Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) (String -> String
forall a. [a] -> [a]
cycle String
bb)

showIconPattern :: Maybe IconPattern -> Float -> Monitor String
showIconPattern :: Maybe IconPattern -> Float -> Monitor String
showIconPattern Maybe IconPattern
Nothing Float
_ = String -> Monitor String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
showIconPattern (Just IconPattern
str) Float
x = String -> Monitor String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Monitor String) -> String -> Monitor String
forall a b. (a -> b) -> a -> b
$ IconPattern
str IconPattern -> IconPattern
forall a b. (a -> b) -> a -> b
$ Float -> Int
forall p a. (Integral p, RealFrac a) => a -> p
convert (Float -> Int) -> Float -> Int
forall a b. (a -> b) -> a -> b
$ Float
100 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x
  where convert :: a -> p
convert a
val
          | p
t p -> p -> Bool
forall a. Ord a => a -> a -> Bool
<= p
0 = p
0
          | p
t p -> p -> Bool
forall a. Ord a => a -> a -> Bool
> p
8 = p
8
          | Bool
otherwise = p
t
          where t :: p
t = a -> p
forall a b. (RealFrac a, Integral b) => a -> b
round a
val p -> p -> p
forall a. Integral a => a -> a -> a
`div` p
12

pShowIconPattern :: Maybe IconPattern -> Float -> IO String
pShowIconPattern :: Maybe IconPattern -> Float -> IO String
pShowIconPattern Maybe IconPattern
Nothing Float
_ = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
pShowIconPattern (Just IconPattern
str) Float
x = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ IconPattern
str IconPattern -> IconPattern
forall a b. (a -> b) -> a -> b
$ Float -> Int
forall p a. (Integral p, RealFrac a) => a -> p
convert (Float -> Int) -> Float -> Int
forall a b. (a -> b) -> a -> b
$ Float
100 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x
  where convert :: a -> p
convert a
val
          | p
t p -> p -> Bool
forall a. Ord a => a -> a -> Bool
<= p
0 = p
0
          | p
t p -> p -> Bool
forall a. Ord a => a -> a -> Bool
> p
8 = p
8
          | Bool
otherwise = p
t
          where t :: p
t = a -> p
forall a b. (RealFrac a, Integral b) => a -> b
round a
val p -> p -> p
forall a. Integral a => a -> a -> a
`div` p
12

showVerticalBar :: Float -> Float -> Monitor String
showVerticalBar :: Float -> Float -> Monitor String
showVerticalBar Float
v Float
x = Float -> String -> Monitor String
forall a. (Num a, Ord a) => a -> String -> Monitor String
colorizeString Float
v [Float -> Char
convert (Float -> Char) -> Float -> Char
forall a b. (a -> b) -> a -> b
$ Float
100 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x]
  where convert :: Float -> Char
        convert :: Float -> Char
convert Float
val
          | Int
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9600 = Char
' '
          | Int
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
9608 = Int -> Char
chr Int
9608
          | Bool
otherwise = Int -> Char
chr Int
t
          where t :: Int
t = Int
9600 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round Float
val Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
12)

logScaling :: Float -> Float -> Monitor Float
logScaling :: Float -> Float -> Monitor Float
logScaling Float
f Float
v = do
  Float
h <- Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Float) -> Monitor Int -> Monitor Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Selector Int -> Monitor Int
forall a. Selector a -> Monitor a
getConfigValue Selector Int
high
  Float
l <- Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Float) -> Monitor Int -> Monitor Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Selector Int -> Monitor Int
forall a. Selector a -> Monitor a
getConfigValue Selector Int
low
  Float
bw <- Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Float) -> Monitor Int -> Monitor Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Selector Int -> Monitor Int
forall a. Selector a -> Monitor a
getConfigValue Selector Int
barWidth
  let [Float
ll, Float
hh] = [Float] -> [Float]
forall a. Ord a => [a] -> [a]
sort [Float
l, Float
h]
      scaled :: Float -> Float
scaled Float
x | Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0.0 = Float
0
               | Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
ll = Float
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
bw
               | Bool
otherwise = Float
f Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float -> Float -> Float
forall a. Floating a => a -> a -> a
logBase Float
2 (Float
x Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
hh) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
bw
  Float -> Monitor Float
forall (m :: * -> *) a. Monad m => a -> m a
return (Float -> Monitor Float) -> Float -> Monitor Float
forall a b. (a -> b) -> a -> b
$ Float -> Float
scaled Float
v

showLogBar :: Float -> Float -> Monitor String
showLogBar :: Float -> Float -> Monitor String
showLogBar Float
f Float
v = Float -> Float -> Monitor Float
logScaling Float
f Float
v Monitor Float -> (Float -> Monitor String) -> Monitor String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Float -> Float -> Monitor String
showPercentBar Float
v

showLogVBar :: Float -> Float -> Monitor String
showLogVBar :: Float -> Float -> Monitor String
showLogVBar Float
f Float
v = Float -> Float -> Monitor Float
logScaling Float
f Float
v Monitor Float -> (Float -> Monitor String) -> Monitor String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Float -> Float -> Monitor String
showVerticalBar Float
v

showLogIconPattern :: Maybe IconPattern -> Float -> Float -> Monitor String
showLogIconPattern :: Maybe IconPattern -> Float -> Float -> Monitor String
showLogIconPattern Maybe IconPattern
str Float
f Float
v = Float -> Float -> Monitor Float
logScaling Float
f Float
v Monitor Float -> (Float -> Monitor String) -> Monitor String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe IconPattern -> Float -> Monitor String
showIconPattern Maybe IconPattern
str