{-# Language OverloadedStrings #-}
{-|
Module      : Client.View.RtsStats
Description : View current GHC RTS statistics
Copyright   : (c) Eric Mertens, 2017
License     : ISC
Maintainer  : emertens@gmail.com

Lines for the @/rtsstats@ command.

-}

module Client.View.RtsStats
  ( rtsStatsLines
  ) where

import           Client.Image.PackedImage
import           Client.Image.Palette
import           Control.Lens
import           Graphics.Vty.Attributes
import           RtsStats

-- | Generate lines used for @/rtsstats@.
rtsStatsLines :: Maybe Stats -> Palette -> [Image']
rtsStatsLines :: Maybe Stats -> Palette -> [Image']
rtsStatsLines Maybe Stats
Nothing Palette
pal = [Attr -> Text -> Image'
text' (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palError Palette
pal) Text
"Statistics not available"]
rtsStatsLines (Just Stats
stats) Palette
pal
  | [(Text, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Text)]
entries = [Attr -> Text -> Image'
text' (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palError Palette
pal) Text
"Statistics empty"]
  | Bool
otherwise    = (Image' -> Image' -> Image') -> [Image'] -> [Image'] -> [Image']
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Image'
v Image'
l -> Int -> Image' -> Image'
padV Int
wv Image'
v Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
" " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
l) [Image']
valueImages [Image']
labelImages
  where
    entries :: [(Text, Text)]
entries     = Stats -> [(Text, Text)]
statsToEntries Stats
stats
    labelImages :: [Image']
labelImages = ((Text, Text) -> Image') -> [(Text, Text)] -> [Image']
forall a b. (a -> b) -> [a] -> [b]
map (Attr -> Text -> Image'
text' (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palLabel Palette
pal) (Text -> Image')
-> ((Text, Text) -> Text) -> (Text, Text) -> Image'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> a
fst) [(Text, Text)]
entries
    valueImages :: [Image']
valueImages = ((Text, Text) -> Image') -> [(Text, Text)] -> [Image']
forall a b. (a -> b) -> [a] -> [b]
map (Attr -> Text -> Image'
text' Attr
defAttr (Text -> Image')
-> ((Text, Text) -> Text) -> (Text, Text) -> Image'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> b
snd) [(Text, Text)]
entries
    wv :: Int
wv          = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (Image' -> Int) -> [Image'] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Image' -> Int
imageWidth [Image']
valueImages)
    padV :: Int -> Image' -> Image'
padV Int
n Image'
img  = Attr -> String -> Image'
string Attr
defAttr (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Image' -> Int
imageWidth Image'
img) Char
' ') Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
img