gtk-sni-tray-0.1.0.0: app/Main.hs

{-# LANGUAGE OverloadedStrings #-}
module Main where

import           Control.Monad
import           DBus.Client
import           Data.Int
import           Data.Maybe
import           Data.Ratio
import           Data.Semigroup ((<>))
import qualified Data.Text as T
import qualified GI.Gtk as Gtk
import qualified GI.Gdk as Gdk
import           Graphics.UI.GIGtkStrut
import           Options.Applicative
import qualified StatusNotifier.Host.Service as Host
import           StatusNotifier.Tray
import           System.Log.Logger
import           System.Posix.Process
import           Text.Printf

positionP :: Parser StrutPosition
positionP = fromMaybe TopPos <$> optional
  (   flag' TopPos
  (  long "top"
  <> help "Position the bar at the top of the screen"
  )
  <|> flag' BottomPos
  (  long "bottom"
  <> help "Position the bar at the bottom of the screen"
  )
  <|> flag' LeftPos
  (  long "left"
  <> help "Position the bar on the left side of the screen"
  )
  <|> flag' RightPos
  (  long "right"
  <> help "Position the bar on the right side of the screen"
  ))

alignmentP :: Parser StrutAlignment
alignmentP = fromMaybe Center <$> optional
  (   flag' Beginning
  (  long "beginning"
  <> help "Use beginning alignment"
  )
  <|> flag' Center
  (  long "center"
  <> help "Use center alignment"
  )
  <|> flag' End
  (  long "end"
  <> help "Use end alignment"
  ))

sizeP :: Parser Int32
sizeP =
  option auto
  (  long "size"
  <> short 's'
  <> help "Set the size of the bar"
  <> value 30
  <> metavar "SIZE"
  )

paddingP :: Parser Int32
paddingP =
  option auto
  (  long "padding"
  <> short 'p'
  <> help "Set the padding of the bar"
  <> value 0
  <> metavar "PADDING"
  )

monitorNumberP :: Parser [Int32]
monitorNumberP = many $
  option auto
  (  long "monitor"
  <> short 'm'
  <> help "Run on the selected monitor"
  <> metavar "MONITOR"
  )

logP :: Parser Priority
logP =
  option auto
  (  long "log-level"
  <> short 'l'
  <> help "Set the log level"
  <> metavar "LEVEL"
  <> value WARNING
  )

colorP :: Parser String
colorP =
  strOption
  (  long "color"
  <> short 'c'
  <> help "Set the background color of the tray"
  <> metavar "COLOR"
  <> value "000000"
  )

expandP :: Parser Bool
expandP =
  switch
  (  long "expand"
  <> help "Whether to let icons expand into the space allocated to the tray"
  <> short 'e'
  )

startWatcherP :: Parser Bool
startWatcherP =
  switch
  (  long "watcher"
  <> help "Whether to start a Watcher to handle SNI registration"
  <> short 'w'
  )

getColor colorString = do
  rgba <- Gdk.newZeroRGBA
  colorParsed <- Gdk.rGBAParse rgba (T.pack colorString)
  unless colorParsed $ do
    logM "StatusNotifier.Tray" WARNING "Failed to parse provided color"
    void $ Gdk.rGBAParse rgba "000000"
  return rgba

buildWindows :: StrutPosition
             -> StrutAlignment
             -> Int32
             -> Int32
             -> [Int32]
             -> Priority
             -> String
             -> Bool
             -> Bool
             -> IO ()
buildWindows pos align size padding monitors priority colorString expand startWatcher = do
  Gtk.init Nothing
  logger <- getLogger "StatusNotifier"
  saveGlobalLogger $ setLevel priority logger
  client <- connectSession
  logger <- getRootLogger
  pid <- getProcessID
  -- Okay to use a forced pattern here because we want to die if this fails anyway
  Just host <- Host.build Host.defaultParams
    { Host.dbusClient = Just client
    , Host.uniqueIdentifier = printf "standalone-%s" $ show pid
    , Host.startWatcher = startWatcher
    }
  let c1 = defaultStrutConfig
           { strutPosition = pos
           , strutAlignment = align
           , strutXPadding = padding
           , strutYPadding = padding
           }
      defaultRatio = ScreenRatio (4 % 5)
      configBase = case pos of
             TopPos -> c1
                       { strutHeight = ExactSize size
                       , strutWidth = defaultRatio
                       }
             BottomPos -> c1
                          { strutHeight = ExactSize size
                          , strutWidth = defaultRatio
                          }
             RightPos -> c1
                         { strutHeight = defaultRatio
                         , strutWidth = ExactSize size
                         }
             LeftPos -> c1
                        { strutHeight = defaultRatio
                        , strutWidth = ExactSize size
                        }
      buildWithConfig config = do
        let orientation =
              case strutPosition config of
                TopPos -> Gtk.OrientationHorizontal
                BottomPos -> Gtk.OrientationHorizontal
                _ -> Gtk.OrientationVertical
        tray <- buildTray TrayParams
                    { trayClient = client
                    , trayOrientation = orientation
                    , trayHost = host
                    , trayImageSize = Expand
                    , trayIconExpand = expand
                    }
        window <- Gtk.windowNew Gtk.WindowTypeToplevel
        setupStrutWindow config window
        (Just <$> getColor colorString) >>=
             Gtk.widgetOverrideBackgroundColor window [Gtk.StateFlagsNormal]
        Gtk.containerAdd window tray
        Gtk.widgetShowAll window
      runForMonitor monitor =
        buildWithConfig configBase { strutMonitor = Just monitor }
  if null monitors
  then buildWithConfig configBase
  else mapM_ runForMonitor monitors
  Gtk.main

parser :: Parser (IO ())
parser = buildWindows <$> positionP <*> alignmentP <*> sizeP <*> paddingP <*>
         monitorNumberP <*> logP <*> colorP <*> expandP <*> startWatcherP

main :: IO ()
main = do
  -- TODO: start watcher if it doesn't exist
  join $ execParser $ info (parser <**> helper)
               (  fullDesc
               <> progDesc "Run a standalone StatusNotifierItem/AppIndicator tray")