File: Main.hs

package info (click to toggle)
haskell-gtk-sni-tray 0.1.5.0-1
  • links: PTS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 104 kB
  • sloc: haskell: 606; makefile: 6
file content (245 lines) | stat: -rw-r--r-- 6,817 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
{-# 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           Data.Version (showVersion)
import qualified GI.Gdk as Gdk
import qualified GI.Gtk as Gtk
import           Graphics.UI.GIGtkStrut
import           Options.Applicative
import qualified StatusNotifier.Host.Service as Host
import           StatusNotifier.TransparentWindow
import           StatusNotifier.Tray
import           System.Log.Logger
import           System.Posix.Process
import           Text.Printf

import           Paths_gtk_sni_tray (version)

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 "Display a tray bar on the given 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 (Maybe String)
colorP = optional $
  strOption
  (  long "color"
  <> short 'c'
  <> help "Set the background color of the tray; See https://developer.gnome.org/gdk3/stable/gdk3-RGBA-Colors.html#gdk-rgba-parse for acceptable values"
  <> metavar "COLOR"
  )

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

startWatcherP :: Parser Bool
startWatcherP =
  switch
  (  long "watcher"
  <> short 'w'
  <> help "Start a Watcher to handle SNI registration if one does not exist"
  )

barLengthP :: Parser Rational
barLengthP =
  option auto
  (  long "length"
  <> help "Set the proportion of the screen that the tray bar should occupy -- values are parsed as haskell rationals (e.g. 1 % 2)"
  <> value 1
  )

overlayScaleP :: Parser Rational
overlayScaleP =
  option auto
  (  long "overlay-scale"
  <> short 'o'
  <> help "The proportion of the tray icon's size that should be set for overlay icons."
  <> value (5 % 7)
  )

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
             -> Maybe String
             -> Bool
             -> Bool
             -> Rational
             -> Rational
             -> IO ()
buildWindows pos align size padding monitors priority maybeColorString expand
             startWatcher length overlayScale = 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 length
      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
            , trayAlignment = align
            , trayOverlayScale = overlayScale
            }
        window <- Gtk.windowNew Gtk.WindowTypeToplevel
        setupStrutWindow config window
        maybe
          (makeWindowTransparent window)
          (getColor >=>
           Gtk.widgetOverrideBackgroundColor window [Gtk.StateFlagsNormal] .
           Just)
          maybeColorString
        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 <*>
  barLengthP <*> overlayScaleP

versionOption :: Parser (a -> a)
versionOption = infoOption
                (printf "gtk-sni-tray-standalone %s" $ showVersion version)
                (  long "version"
                <> help "Show the version number of gtk-sni-tray"
                )

main :: IO ()
main =
  join $ execParser $ info (helper <*> versionOption <*> parser)
         (  fullDesc
         <> progDesc "Run a standalone StatusNotifierItem/AppIndicator tray"
         )