{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      : System.Taffybar.Example
-- Copyright   : (c) Ivan A. Malison
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : Ivan A. Malison
-- Stability   : unstable
-- Portability : unportable
-----------------------------------------------------------------------------
module System.Taffybar.Example where

-- XXX: in an actual taffybar.hs configuration file, you will need the module
-- name to be Main, and you would need to have a main function defined at the
-- top level, e.g.
--
-- > main = dyreTaffybar exampleTaffybarConfig

import Data.Default (def)
import System.Taffybar.Context (TaffybarConfig(..))
import System.Taffybar.Hooks
import System.Taffybar.Information.CPU
import System.Taffybar.Information.Memory
import System.Taffybar.SimpleConfig
import System.Taffybar.Widget
import System.Taffybar.Widget.Generic.PollingGraph

transparent, yellow1, yellow2, green1, green2, taffyBlue
  :: (Double, Double, Double, Double)
transparent :: (Double, Double, Double, Double)
transparent = (Double
0.0, Double
0.0, Double
0.0, Double
0.0)
yellow1 :: (Double, Double, Double, Double)
yellow1 = (Double
0.9453125, Double
0.63671875, Double
0.2109375, Double
1.0)
yellow2 :: (Double, Double, Double, Double)
yellow2 = (Double
0.9921875, Double
0.796875, Double
0.32421875, Double
1.0)
green1 :: (Double, Double, Double, Double)
green1 = (Double
0, Double
1, Double
0, Double
1)
green2 :: (Double, Double, Double, Double)
green2 = (Double
1, Double
0, Double
1, Double
0.5)
taffyBlue :: (Double, Double, Double, Double)
taffyBlue = (Double
0.129, Double
0.588, Double
0.953, Double
1)

myGraphConfig, netCfg, memCfg, cpuCfg :: GraphConfig
myGraphConfig :: GraphConfig
myGraphConfig =
  GraphConfig
forall a. Default a => a
def
  { graphPadding :: Int
graphPadding = Int
0
  , graphBorderWidth :: Int
graphBorderWidth = Int
0
  , graphWidth :: Int
graphWidth = Int
75
  , graphBackgroundColor :: (Double, Double, Double, Double)
graphBackgroundColor = (Double, Double, Double, Double)
transparent
  }

netCfg :: GraphConfig
netCfg = GraphConfig
myGraphConfig
  { graphDataColors :: [(Double, Double, Double, Double)]
graphDataColors = [(Double, Double, Double, Double)
yellow1, (Double, Double, Double, Double)
yellow2]
  , graphLabel :: Maybe Text
graphLabel = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"net"
  }

memCfg :: GraphConfig
memCfg = GraphConfig
myGraphConfig
  { graphDataColors :: [(Double, Double, Double, Double)]
graphDataColors = [(Double, Double, Double, Double)
taffyBlue]
  , graphLabel :: Maybe Text
graphLabel = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"mem"
  }

cpuCfg :: GraphConfig
cpuCfg = GraphConfig
myGraphConfig
  { graphDataColors :: [(Double, Double, Double, Double)]
graphDataColors = [(Double, Double, Double, Double)
green1, (Double, Double, Double, Double)
green2]
  , graphLabel :: Maybe Text
graphLabel = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"cpu"
  }

memCallback :: IO [Double]
memCallback :: IO [Double]
memCallback = do
  MemoryInfo
mi <- IO MemoryInfo
parseMeminfo
  [Double] -> IO [Double]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [MemoryInfo -> Double
memoryUsedRatio MemoryInfo
mi]

cpuCallback :: IO [Double]
cpuCallback :: IO [Double]
cpuCallback = do
  (Double
_, Double
systemLoad, Double
totalLoad) <- IO (Double, Double, Double)
cpuLoad
  [Double] -> IO [Double]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Double
totalLoad, Double
systemLoad]

exampleTaffybarConfig :: TaffybarConfig
exampleTaffybarConfig :: TaffybarConfig
exampleTaffybarConfig =
  let myWorkspacesConfig :: WorkspacesConfig
myWorkspacesConfig =
        WorkspacesConfig
forall a. Default a => a
def
        { minIcons :: Int
minIcons = Int
1
        , widgetGap :: Int
widgetGap = Int
0
        , showWorkspaceFn :: Workspace -> Bool
showWorkspaceFn = Workspace -> Bool
hideEmpty
        }
      workspaces :: TaffyIO Widget
workspaces = WorkspacesConfig -> TaffyIO Widget
workspacesNew WorkspacesConfig
myWorkspacesConfig
      cpu :: TaffyIO Widget
cpu = GraphConfig -> Double -> IO [Double] -> TaffyIO Widget
forall (m :: * -> *).
MonadIO m =>
GraphConfig -> Double -> IO [Double] -> m Widget
pollingGraphNew GraphConfig
cpuCfg Double
0.5 IO [Double]
cpuCallback
      mem :: TaffyIO Widget
mem = GraphConfig -> Double -> IO [Double] -> TaffyIO Widget
forall (m :: * -> *).
MonadIO m =>
GraphConfig -> Double -> IO [Double] -> m Widget
pollingGraphNew GraphConfig
memCfg Double
1 IO [Double]
memCallback
      net :: TaffyIO Widget
net = GraphConfig -> Maybe [String] -> TaffyIO Widget
networkGraphNew GraphConfig
netCfg Maybe [String]
forall a. Maybe a
Nothing
      clock :: TaffyIO Widget
clock = ClockConfig -> TaffyIO Widget
forall (m :: * -> *). MonadIO m => ClockConfig -> m Widget
textClockNewWith ClockConfig
forall a. Default a => a
def
      layout :: TaffyIO Widget
layout = LayoutConfig -> TaffyIO Widget
layoutNew LayoutConfig
forall a. Default a => a
def
      windowsW :: TaffyIO Widget
windowsW = WindowsConfig -> TaffyIO Widget
windowsNew WindowsConfig
forall a. Default a => a
def
      -- See https://github.com/taffybar/gtk-sni-tray#statusnotifierwatcher
      -- for a better way to set up the sni tray
      tray :: TaffyIO Widget
tray = TaffyIO Widget
sniTrayThatStartsWatcherEvenThoughThisIsABadWayToDoIt
      myConfig :: SimpleTaffyConfig
myConfig = SimpleTaffyConfig
forall a. Default a => a
def
        { startWidgets :: [TaffyIO Widget]
startWidgets =
            TaffyIO Widget
workspaces TaffyIO Widget -> [TaffyIO Widget] -> [TaffyIO Widget]
forall a. a -> [a] -> [a]
: (TaffyIO Widget -> TaffyIO Widget)
-> [TaffyIO Widget] -> [TaffyIO Widget]
forall a b. (a -> b) -> [a] -> [b]
map (TaffyIO Widget -> (Widget -> TaffyIO Widget) -> TaffyIO Widget
forall a b.
ReaderT Context IO a
-> (a -> ReaderT Context IO b) -> ReaderT Context IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Widget -> TaffyIO Widget
forall (m :: * -> *). MonadIO m => Widget -> m Widget
buildContentsBox) [ TaffyIO Widget
layout, TaffyIO Widget
windowsW ]
        , endWidgets :: [TaffyIO Widget]
endWidgets = (TaffyIO Widget -> TaffyIO Widget)
-> [TaffyIO Widget] -> [TaffyIO Widget]
forall a b. (a -> b) -> [a] -> [b]
map (TaffyIO Widget -> (Widget -> TaffyIO Widget) -> TaffyIO Widget
forall a b.
ReaderT Context IO a
-> (a -> ReaderT Context IO b) -> ReaderT Context IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Widget -> TaffyIO Widget
forall (m :: * -> *). MonadIO m => Widget -> m Widget
buildContentsBox)
          [ TaffyIO Widget
batteryIconNew
          , TaffyIO Widget
clock
          , TaffyIO Widget
tray
          , TaffyIO Widget
cpu
          , TaffyIO Widget
mem
          , TaffyIO Widget
net
          , TaffyIO Widget
mpris2New
          ]
        , barPosition :: Position
barPosition = Position
Top
        , barPadding :: Int
barPadding = Int
10
        , barHeight :: StrutSize
barHeight = Int32 -> StrutSize
ExactSize Int32
50
        , widgetSpacing :: Int
widgetSpacing = Int
0
        }
  in TaffybarConfig -> TaffybarConfig
withBatteryRefresh (TaffybarConfig -> TaffybarConfig)
-> TaffybarConfig -> TaffybarConfig
forall a b. (a -> b) -> a -> b
$ TaffybarConfig -> TaffybarConfig
withLogServer (TaffybarConfig -> TaffybarConfig)
-> TaffybarConfig -> TaffybarConfig
forall a b. (a -> b) -> a -> b
$
     TaffybarConfig -> TaffybarConfig
withToggleServer (TaffybarConfig -> TaffybarConfig)
-> TaffybarConfig -> TaffybarConfig
forall a b. (a -> b) -> a -> b
$ SimpleTaffyConfig -> TaffybarConfig
toTaffyConfig SimpleTaffyConfig
myConfig