packages feed

xmobar 0.38 → 0.39

raw patch · 19 files changed

+415/−78 lines, 19 filesdep +aesondep +textdep +unordered-containersdep ~base

Dependencies added: aeson, text, unordered-containers, vector, websockets, wuss

Dependency ranges changed: base

Files

changelog.md view
@@ -1,3 +1,20 @@+## Version 0.39 (unreleased)++_New features_++  - New constructors for only controlling bar height:+    TopH and BottomH for Top and Bottom respectively+  - New monitor: k10temp (Sam Kirby)+  - Better handling of command line arguments for Haskell-based+    configuration keys (see #553 and #554)+  - New monitor: Kraken (Amid Saeid)++_Bug fixes_++  - NotmuchMail usable in text configurations (#547)+  - Fix for off-by-one in padding (#560)+  - Fixes for Kbd (#561)+ ## Version 0.38 (May, 2021)  _Bug fixes_@@ -49,7 +66,7 @@ _New features_    - `MultiCoreTemp` now works with Ryzen processors.  New option-    `--hwmonitor-path` for better performance.+    `--hwmon-path` for better performance.   - CPU Monitor optimizations.   - Version bumps for some dependencies, including timezone-olson.
doc/plugins.org view
@@ -424,7 +424,7 @@      limit for percentage calculation.    - =--maxtemp=: temperature in degree Celsius, that sets the upper      limit for percentage calculation.-   - =--hwmonitor-path=: this monitor tries to find coretemp devices by+   - =--hwmon-path=: this monitor tries to find coretemp devices by      looking for them in directories following the pattern      =/sys/bus/platform/devices/coretemp.*/hwmon/hwmon*=, but some      processors (notably Ryzen) might expose those files in a different@@ -455,6 +455,39 @@                         "-l", "green", "-n", "yellow", "-h", "red",                         "--", "--mintemp", "20", "--maxtemp", "100"] 50    #+end_src++*** =K10Temp Slot Args RefreshRate=++ - Aliases to =k10temp=++ - Slot: The PCI slot address of the k10temp device++ - Args: default monitor arguments++ - Thresholds refer to temperature in degrees++ - Variables that can be used with the =-t/--template= argument:+   =Tctl=, =Tdie=, =Tccd1=, .., =Tccd8=++ - Default template: =Temp: <Tdie>C=++ - This monitor requires k10temp module to be loaded in kernel++ - It is important to note that not all measurements are available+   on on all models of processor. Of particular importance - Tdie+   (used in the default template) may not be present on processors+   prior to Zen (17h). Tctl, however, may be offset from the real+   temperature and so is not used by default.++ - Example:++   #+begin_src haskell+     Run CoreTemp ["-t", "Temp: <Tdie>C|<Tccd1>C",+                   "-L", "40", "-H", "60",+                   "-l", "lightblue", "-n", "gray90", "-h", "red"] 50+   #+end_src++ *** =Memory Args RefreshRate=   - Aliases to =memory=@@ -875,18 +908,6 @@    #+begin_src haskell      [ MailItem "name" "address" "query"      ...-     ]-   #+end_src--   or, using explicit record syntax:--   #+begin_src haskell-     [ MailItem-         { name    = "name"-         , address = "address"-         , query   = "query"-         }-       ...      ]    #+end_src
doc/quick-start.org view
@@ -29,8 +29,8 @@  - =alpha= The transparency. 0 is transparent, 255 is opaque. -- =position= Top, TopP, TopW, TopSize, Bottom, BottomP, BottomW,-  BottomSize or Static (with x, y, width and height).+- =position= Top, TopH, TopP, TopW, TopSize, Bottom, BottomH,+  BottomP, BottomW, BottomSize or Static (with x, y, width and height).    TopP and BottomP take 2 arguments: left padding and right padding. @@ -42,7 +42,21 @@   integer for the percentage width, and an integer for the minimum pixel   height that the xmobar window will have. +  TopH and BottomH take one argument (Int) which adjusts the bar height.+   For example:++  #+begin_src haskell+    position = TopH 30+  #+end_src++  to make a 30 tall bar on the top, or++  #+begin_src haskell+    position = BottomH 30+  #+end_src++  to make a 30 tall bar on the bottom of the screen.    #+begin_src haskell     position = BottomW C 75
readme.org view
@@ -51,6 +51,11 @@   xbps-install xmobar #+end_src +*** Gentoo+#+begin_src shell+  emerge --ask xmobar+#+end_src+ ** Using cabal-install  Xmobar is available from [[http://hackage.haskell.org/package/xmobar/][Hackage]], and you can install it using@@ -126,18 +131,19 @@ Boeckel, Ivan Brennan, Duncan Burke, Roman Cheplyaka, Patrick Chilton, Antoine Eiche, Nathaniel Wesley Filardo, John Goerzen, Reto Hablützel, Juraj Hercek, Tomáš Janoušek, Ada Joule, Spencer Janssen, Roman Joost,-Jochen Keil, Lennart Kolmodin, Krzysztof Kosciuszkiewicz, Dmitry-Kurochkin, Todd Lunter, Vanessa McHale, Robert J. Macomber, Dmitry-Malikov, David McLean, Marcin Mikołajczyk, Dino Morelli, Tony Morris,-Eric Mrak, Thiago Negri, Edward O'Callaghan, Svein Ove, Martin Perner,-Jens Petersen, Alexander Polakov, Sibi Prabakaran, Pavan Rikhi, Petr-Rockai, Andrew Emmanuel Rosa, Sackville-West, Markus Scherer, Daniel-Schüssler, Olivier Schneider, Alexander Shabalin, Valentin Shirokov,-Peter Simons, Alexander Solovyov, Will Song, John Soros, Felix Springer,-Travis Staton, Artem Tarasov, Samuli Thomasson, Edward Tjörnhammar,-Sergei Trofimovich, Thomas Tuegel, John Tyree, Jan Vornberger, Anton-Vorontsov, Daniel Wagner, Zev Weiss, Phil Xiaojun Hu, Edward Z. Yang and-Norbert Zeh.+Jochen Keil, Sam Kirby, Lennart Kolmodin, Krzysztof Kosciuszkiewicz,+Dmitry Kurochkin, Todd Lunter, Vanessa McHale, Robert J. Macomber,+Dmitry Malikov, David McLean, Joan MIlev, Marcin Mikołajczyk, Dino+Morelli, Tony Morris, Eric Mrak, Thiago Negri, Edward O'Callaghan,+Svein Ove, Martin Perner, Jens Petersen, Alexander Polakov, Sibi+Prabakaran, Pavan Rikhi, Petr Rockai, Andrew Emmanuel Rosa,+Sackville-West, Amir Saeid, Markus Scherer, Daniel Schüssler, Olivier+Schneider, Alexander Shabalin, Valentin Shirokov, Peter Simons,+Alexander Solovyov, Will Song, John Soros, Felix Springer, Travis+Staton, Artem Tarasov, Samuli Thomasson, Edward Tjörnhammar, Sergei+Trofimovich, Thomas Tuegel, John Tyree, Jan Vornberger, Anton+Vorontsov, Daniel Wagner, Zev Weiss, Phil Xiaojun Hu, Nikolay Yakimov,+aEdward Z. Yang, Leo Zhang, and Norbert Zeh.  ** Thanks
src/Xmobar/App/Main.hs view
@@ -73,14 +73,14 @@   for_ (concat vars) $ \(asyncs, _) ->     for_ asyncs cancel -buildLaunch :: Bool -> Bool -> String -> ParseError -> IO ()-buildLaunch verb force p e = do+buildLaunch :: [String] -> Bool -> Bool -> String -> ParseError -> IO ()+buildLaunch args verb force p e = do   let exec = takeBaseName p       confDir = takeDirectory p       ext = takeExtension p   if ext `elem` [".hs", ".hsc", ".lhs"]     then xmobarDataDir >>= \dd -> recompile confDir dd exec force verb >>-         executeFile (confDir </> exec) False [] Nothing+         executeFile (confDir </> exec) False args Nothing     else trace True ("Invalid configuration file: " ++ show e) >>          trace True "\n(No compilation attempted: \                     \only .hs, .hsc or .lhs files are compiled)"@@ -106,5 +106,5 @@     Just p -> do r <- readConfig defaultConfig p                  case r of                    Left e ->-                     buildLaunch (verboseFlag flags) (recompileFlag flags) p e+                     buildLaunch (filter (/= p) args) (verboseFlag flags) (recompileFlag flags) p e                    Right (c, defs) -> doOpts c flags >>= xmobar' defs
src/Xmobar/Config/Types.hs view
@@ -65,21 +65,23 @@                                     --   right text alignment            , template :: String     -- ^ The output template            , verbose :: Bool        -- ^ Emit additional debug messages-           } deriving (Read)+           } deriving (Read, Show)  data XPosition = Top+               | TopH Int                | TopW Align Int                | TopSize Align Int Int                | TopP Int Int                | Bottom+               | BottomH Int                | BottomP Int Int                | BottomW Align Int                | BottomSize Align Int Int                | Static {xpos, ypos, width, height :: Int}                | OnScreen Int XPosition-                 deriving ( Read, Eq )+                 deriving ( Read, Show, Eq ) -data Align = L | R | C deriving ( Read, Eq )+data Align = L | R | C deriving ( Read, Show, Eq )  data Border = NoBorder             | TopB@@ -88,4 +90,4 @@             | TopBM Int             | BottomBM Int             | FullBM Int-              deriving ( Read, Eq )+              deriving ( Read, Show, Eq )
src/Xmobar/Plugins/Kbd.hs view
@@ -14,9 +14,11 @@  module Xmobar.Plugins.Kbd(Kbd(..)) where -import Data.List (isPrefixOf, findIndex)-import Data.Maybe (fromJust)+import Data.List (isPrefixOf)+import Data.Maybe (fromMaybe)+import Data.Char (toLower) import Control.Monad (forever)+import Control.Applicative ((<|>)) import Graphics.X11.Xlib import Graphics.X11.Xlib.Extras @@ -27,47 +29,46 @@  -- 'Bad' prefixes of layouts noLaySymbols :: [String]-noLaySymbols = ["group", "inet", "ctr", "pc", "ctrl", "terminate"]+noLaySymbols = ["group", "inet", "ctr", "compose", "pc", "ctrl", "terminate"]   -- splits the layout string into the actual layouts splitLayout :: String -> [String]-splitLayout s = splitLayout' noLaySymbols $ split s '+'--splitLayout' :: [String] ->  [String] -> [String]---                  end of recursion, remove empty strings-splitLayout' [] s = map (takeWhile (/= ':')) $ filter (not . null) s---                    remove current string if it has a 'bad' prefix-splitLayout' bad s  =-  splitLayout' (tail bad) [x | x <- s, not $ isPrefixOf (head bad) x]+splitLayout s+  = filter flt+  . map (takeWhile (/= ':'))+  $ split (=='+') s+  where+  flt "" = False+  flt s' = not $ any (`isPrefixOf` s') noLaySymbols  -- split String at each Char-split :: String -> Char -> [String]-split [] _ = [""]-split (c:cs) delim-    | c == delim = "" : rest-    | otherwise = (c : head rest) : tail rest-        where-            rest = split cs delim+split :: (Char -> Bool) -> String -> [String]+split p s = case break p s of+  (pref, _:suf) -> pref : split p suf+  (pref, "") -> [pref]  -- replaces input string if on search list (exact match) with corresponding -- element on replacement list. -- -- if not found, return string unchanged searchReplaceLayout :: KbdOpts -> String -> String-searchReplaceLayout opts s = let c = findIndex (\x -> fst x == s) opts in-    case c of-        Nothing -> s-        x -> let i = fromJust x in snd $ opts!!i+searchReplaceLayout opts s = fromMaybe s $ lookup s opts  -- returns the active layout getKbdLay :: Display -> KbdOpts -> IO String getKbdLay dpy opts = do-        lay <- getLayoutStr dpy-        curLay <- getKbdLayout dpy-        return $ searchReplaceLayout opts $ splitLayout lay!!curLay-+  lay <- splitLayout <$> getLayoutStr dpy+  grps <- map (map toLower . take 2) <$> getGrpNames dpy+  curLay <- getKbdLayout dpy+  return $ searchReplaceLayout opts+         $ fromMaybe "??"+         $ (lay !!? curLay) <|> (grps !!? curLay) +(!!?) :: [a] -> Int -> Maybe a+(!!?) []       _ = Nothing+(!!?) (x : _)  0 = Just x+(!!?) (_ : xs) i = xs !!? (i - 1)  newtype Kbd = Kbd [(String, String)]   deriving (Read, Show)
+ src/Xmobar/Plugins/Kraken.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveGeneric #-}++module Xmobar.Plugins.Kraken (Kraken(..)) where++import Control.Concurrent (MVar, newEmptyMVar, putMVar, takeMVar)+import Control.Concurrent.Async (async, cancel)+import Control.Exception (bracket, catch)+import Control.Monad (forever, mzero, void, when)+import Data.Aeson+import Data.Aeson.Types (Parser, typeMismatch)+import Data.List (sort)+import Data.Text (Text, pack, unpack)+import GHC.Generics+import Network.WebSockets (ClientApp, ConnectionException(ConnectionClosed), receiveData, sendTextData)+import System.IO (hPutStrLn, stderr)+import Text.Read (readMaybe)+import Wuss (runSecureClient)+import Xmobar.Run.Exec(Exec(..))++import qualified Data.HashMap.Lazy as HML (lookup)+import qualified Data.Map as Map+import qualified Data.Vector as V++data Kraken = Kraken [String] String+  deriving (Read, Show)++instance Exec Kraken where+  alias (Kraken _ a) = a+  start (Kraken ps _) cb = do+    mvar <- newEmptyMVar +    bracket (async $ reconnectOnConnectionClose $ wsClientApp ps mvar) cancel $ \_ -> do+      let loop mv p = do+           v <- takeMVar mv+           let g = Map.insert (unpack $ fst v) (snd v) p+           cb (display g)+           loop mv g++      loop mvar (Map.fromList $ zip ps (repeat 0.0))++    where+      display :: Map.Map String Double -> String +      display m = unwords $ sort $ map (\x -> fst x ++ ": " ++ show (snd x)) $ Map.toList m++      reconnectOnConnectionClose :: ClientApp () -> IO ()+      reconnectOnConnectionClose ws = runSecureClient "ws.kraken.com" 443 "/" ws+        `catch` (\e -> when (e == ConnectionClosed) $ reconnectOnConnectionClose ws)++wsClientApp :: [String] -> MVar (Text, Double)  -> ClientApp ()+wsClientApp ps mvar connection = do+  sendTextData connection (encode Subscribe { event = "subscribe", pair = map pack ps, subscription = Subscription { name = "ticker" }})+  void . forever $ do+    message <- receiveData connection+    case (eitherDecode message :: Either String Message) of+      Right m ->+        case m of+          TickerMessage _ ti _ tp  -> putMVar mvar (tp, askPrice $ ask ti)+          _ -> return ()+      Left e -> hPutStrLn stderr e++data Ask = Ask {+    askPrice :: Double+  , askWholeLotVolume :: Int+  , askLotVolume :: Double+  } deriving Show++parseDoubleString :: Value -> Parser Double+parseDoubleString v = do+  j <- parseJSON v+  case readMaybe j of+    Just num -> return num+    Nothing -> typeMismatch "Double inside a String" v++instance FromJSON Ask where +  parseJSON (Array v)+    | V.length v == 3 = do+      p <- parseDoubleString $ v V.! 0+      w <- parseJSON $ v V.! 1+      l <- parseDoubleString $ v V.! 2+      return Ask { askPrice = p, askWholeLotVolume = w, askLotVolume = l }+    | otherwise = mzero+  parseJSON nonArray = typeMismatch "Array" nonArray++data Bid = Bid {+    bidPrice :: Double+  , bidWholeLotVolume :: Int+  , bidLotVolume :: Double+  } deriving Show++instance FromJSON Bid where +  parseJSON (Array v)+    | V.length v == 3 = do+      p <- parseDoubleString $ v V.! 0+      w <- parseJSON $ v V.! 1+      l <- parseDoubleString $ v V.! 2+      return Bid { bidPrice = p, bidWholeLotVolume = w, bidLotVolume = l }+    | otherwise = mzero+  parseJSON nonArray = typeMismatch "Array" nonArray++data Close = Close {+    closePrice :: Double+  , closeLotVolume :: Double+  } deriving Show++instance FromJSON Close where +  parseJSON (Array v)+    | V.length v == 2 = do+      p <- parseDoubleString $ v V.! 0+      l <- parseDoubleString $ v V.! 1+      return Close { closePrice= p, closeLotVolume = l }+    | otherwise = mzero+  parseJSON nonArray = typeMismatch "Array" nonArray++data TickerInformation = TickerInformation {+    ask :: Ask+  , bid :: Bid+  , close :: Close+  } deriving Show++instance FromJSON TickerInformation where +  parseJSON = withObject "P" $ \v -> TickerInformation+    <$> v .: "a"+    <*> v .: "b"+    <*> v .: "c"+  +data Message =+    Heartbeat+  | TickerMessage { channelId :: Int, tickerInformation :: TickerInformation, channelName :: Text, tickerPair :: Text }+  | SubscriptionStatus { channelName :: Text, status :: Text, subscriptionPair :: Text }+  | SystemStatus { connectionId :: Integer, status :: Text, version :: Text }+  | UnrecognizedMessage String+  deriving Show++newtype Subscription = Subscription { name :: Text } deriving (Generic, Show)+instance ToJSON Subscription where+  toEncoding = genericToEncoding defaultOptions++data Subscribe = Subscribe { event :: Text, pair :: [Text], subscription :: Subscription } deriving (Generic, Show)+instance ToJSON Subscribe where+  toEncoding = genericToEncoding defaultOptions++instance FromJSON Message where+  parseJSON (Object o) = case HML.lookup (pack "event") o of+    Just (String "heartbeat") -> pure Heartbeat+    Just (String "systemStatus") -> systemStatus o+    Just (String "subscriptionStatus") -> subscriptionStatus o+    Just eventType -> pure $ UnrecognizedMessage $ "Unrecognized event type " ++ show eventType+    Nothing -> pure $ UnrecognizedMessage "Missing event"+    where+      systemStatus obj = SystemStatus <$> obj .: "connectionID" <*> obj .: "status" <*> obj .: "version"+      subscriptionStatus obj = SubscriptionStatus <$> obj .: "channelName" <*> obj .: "status" <*> obj .: "pair"+  parseJSON (Array a)+    | V.length a == 4 = do+      cId   <- parseJSON $ a V.! 0+      info  <- parseJSON $ a V.! 1+      cName <- parseJSON $ a V.! 2+      p     <- parseJSON $ a V.! 3+      pure TickerMessage { channelId = cId, tickerInformation = info, channelName = cName, tickerPair = p }+    | otherwise = mzero+  parseJSON v = typeMismatch "Object or Array" v
src/Xmobar/Plugins/Monitors.hs view
@@ -35,6 +35,7 @@ import Xmobar.Plugins.Monitors.CpuFreq import Xmobar.Plugins.Monitors.CoreTemp import Xmobar.Plugins.Monitors.MultiCoreTemp+import Xmobar.Plugins.Monitors.K10Temp import Xmobar.Plugins.Monitors.Disk import Xmobar.Plugins.Monitors.Top import Xmobar.Plugins.Monitors.Uptime@@ -74,6 +75,7 @@               | CpuFreq      Args        Rate               | CoreTemp     Args        Rate               | MultiCoreTemp Args       Rate+              | K10Temp      Slot        Args Rate               | TopProc      Args        Rate               | TopMem       Args        Rate               | Uptime       Args        Rate@@ -113,6 +115,7 @@ type Interface = String type Rate      = Int type DiskSpec  = [(String, String)]+type Slot      = String  instance Exec Monitors where #ifdef WEATHER@@ -136,6 +139,7 @@     alias (TopMem _ _) = "topmem"     alias (CoreTemp _ _) = "coretemp"     alias (MultiCoreTemp _ _) = "multicoretemp"+    alias K10Temp {} = "k10temp"     alias DiskU {} = "disku"     alias DiskIO {} = "diskio"     alias (Uptime _ _) = "uptime"@@ -181,6 +185,7 @@     start (CpuFreq a r) = runM a cpuFreqConfig runCpuFreq r     start (CoreTemp a r) = runM a coreTempConfig runCoreTemp r     start (MultiCoreTemp a r) = startMultiCoreTemp a r+    start (K10Temp s a r) = runM (a ++ [s]) k10TempConfig runK10Temp r     start (DiskU s a r) = runM a diskUConfig (runDiskU s) r     start (DiskIO s a r) = startDiskIO s a r     start (Uptime a r) = runM a uptimeConfig runUptime r
src/Xmobar/Plugins/Monitors/Common/Output.hs view
@@ -140,7 +140,7 @@ padString :: Int -> Int -> String -> Bool -> String -> String -> String padString mnw mxw pad pr ellipsis s =   let len = length s-      rmin = if mnw <= 0 then 1 else mnw+      rmin = if mnw < 0 then 0 else mnw       rmax = if mxw <= 0 then max len rmin else mxw       (rmn, rmx) = if rmin <= rmax then (rmin, rmax) else (rmax, rmin)       rlen = min (max rmn len) rmx
+ src/Xmobar/Plugins/Monitors/K10Temp.hs view
@@ -0,0 +1,41 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Plugins.Monitors.CoreTemp+-- Copyright   :  (c) Juraj Hercek+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Juraj Hercek <juhe_haskell@hck.sk>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A temperature monitor that works with AMD CPUs for Xmobar+--+-----------------------------------------------------------------------------++module Xmobar.Plugins.Monitors.K10Temp where++import Xmobar.Plugins.Monitors.Common++-- |+-- K10 temperature default configuration. Default template contains only the+-- die temperature, user should specify custom template in order to get more+-- ccd or IO die temperatures.+k10TempConfig :: IO MConfig+k10TempConfig = mkMConfig+       "Temp: <Tdie>C" -- template+       ["Tctl", "Tdie", "Tccd1", "Tccd2", "Tccd3"+       ,"Tccd4", "Tccd5", "Tccd6", "Tccd7", "Tccd8"+       ] -- available replacements++-- |+-- Function retrieves monitor string holding the temperature+-- (or temperatures)+runK10Temp :: [String] -> Monitor String+runK10Temp args = do+   dn <- getConfigValue decDigits+   failureMessage <- getConfigValue naString+   let slot = head args+       path = ["/sys/bus/pci/drivers/k10temp/" ++ slot ++ "/hwmon/hwmon", "/temp", "_input"]+       divisor = 1e3 :: Double+       show' = showDigits (max 0 dn)+   checkedDataRetrieval failureMessage [path] Nothing (/divisor) show'
src/Xmobar/Plugins/NotmuchMail.hs view
@@ -39,6 +39,7 @@ import Data.Maybe (catMaybes) import System.Exit (ExitCode(ExitSuccess)) import System.Process (readProcessWithExitCode)+import Text.Read (Lexeme(Ident), ReadPrec, lexP, parens, prec, readPrec, reset)   -- | A 'MailItem' is a name, an address, and a query to give to @notmuch@.@@ -48,15 +49,27 @@                        --   the empty string to query all indexed mail instead   , query   :: String  -- ^ Query to give to @notmuch search@   }-  deriving (Read, Show)+  deriving (Show) +instance Read MailItem where+  readPrec :: ReadPrec MailItem+  readPrec = parens . prec 11 $ do+    Ident "MailItem" <- lexP+    MailItem <$> reset readPrec <*> reset readPrec <*> reset readPrec+ -- | A full mail configuration. data NotmuchMail = NotmuchMail   { nmAlias   :: String      -- ^ Alias for the template string   , mailItems :: [MailItem]  -- ^ 'MailItem's to check   , nmRate    :: Int         -- ^ Update frequency (in deciseconds)   }-  deriving (Read, Show)+  deriving (Show)++instance Read NotmuchMail where+  readPrec :: ReadPrec NotmuchMail+  readPrec = parens . prec 11 $ do+    Ident "NotmuchMail" <- lexP+    NotmuchMail <$> reset readPrec <*> reset readPrec <*> reset readPrec  -- | How to execute this plugin. instance Exec NotmuchMail where
src/Xmobar/Run/Runnable.hs view
@@ -34,7 +34,7 @@      trigger (Run a) = trigger a  instance Show Runnable where-    show (Run x) = show x+    show (Run x) = "Run " ++ show x  instance Read Runnable where     readPrec = readRunnable
src/Xmobar/Run/Runnable.hs-boot view
@@ -4,5 +4,6 @@  data Runnable = forall r . (Exec r,Read r,Show r) => Run r +instance Show Runnable instance Read Runnable instance Exec Runnable
src/Xmobar/Run/Types.hs view
@@ -30,6 +30,7 @@ import Xmobar.Plugins.EWMH import Xmobar.Plugins.Kbd import Xmobar.Plugins.Locks+import Xmobar.Plugins.NotmuchMail  #ifdef INOTIFY import Xmobar.Plugins.Mail@@ -40,6 +41,10 @@ import Xmobar.Plugins.DateZone #endif +#ifdef KRAKEN+import Xmobar.Plugins.Kraken+#endif+ import Xmobar.Run.Command  -- | An alias for tuple types that is more convenient for long lists.@@ -54,12 +59,15 @@ -- this function's type signature. runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*:                  BufferedPipeReader :*: CommandReader :*: StdinReader :*:-                 XMonadLog :*: EWMH :*: Kbd :*: Locks :*:+                 XMonadLog :*: EWMH :*: Kbd :*: Locks :*: NotmuchMail :*: #ifdef INOTIFY                  Mail :*: MBox :*: #endif #ifdef DATEZONE                  DateZone :*:+#endif+#ifdef KRAKEN+                 Kraken :*: #endif                  MarqueePipeReader :*: () runnableTypes = undefined
src/Xmobar/System/Kbd.hsc view
@@ -15,11 +15,14 @@  module Xmobar.System.Kbd where +import Control.Monad ((<=<))+ import Foreign import Foreign.C.Types import Foreign.C.String  import Graphics.X11.Xlib+import Graphics.X11.Xlib.Extras (none)  #include <X11/XKBlib.h> #include <X11/extensions/XKB.h>@@ -113,9 +116,9 @@     symbols :: Atom,     types :: Atom,     compat :: Atom,-    vmods :: Ptr Atom,-    indicators :: Ptr Atom, -- array-    groups :: Ptr Atom, -- array+    vmods :: [Atom], -- Atom              vmods[XkbNumVirtualMods];+    indicators :: [Atom], -- Atom              indicators[XkbNumIndicators];+    groups :: [Atom], -- Atom              groups[XkbNumKbdGroups];     keys :: Ptr XkbKeyNameRec,     key_aliases :: Ptr CChar, -- dont care XkbKeyAliasRec,     radio_groups :: Ptr Atom,@@ -178,9 +181,9 @@         r_symbols <- (#peek XkbNamesRec, symbols ) ptr         r_types <- (#peek XkbNamesRec, types ) ptr         r_compat <- (#peek XkbNamesRec, compat ) ptr-        r_vmods <- (#peek XkbNamesRec,  vmods ) ptr-        r_indicators <- (#peek XkbNamesRec, indicators ) ptr-        r_groups <- (#peek XkbNamesRec, groups ) ptr+        r_vmods <- peekArray (#const XkbNumVirtualMods) $ (#ptr XkbNamesRec,  vmods ) ptr+        r_indicators <- peekArray (#const XkbNumIndicators) $ (#ptr XkbNamesRec, indicators ) ptr+        r_groups <- peekArray (#const XkbNumKbdGroups) $ (#ptr XkbNamesRec, groups ) ptr         r_keys <- (#peek XkbNamesRec, keys ) ptr         r_key_aliases <- (#peek XkbNamesRec, key_aliases  ) ptr         r_radio_groups <- (#peek XkbNamesRec, radio_groups  ) ptr@@ -303,7 +306,7 @@         kbdDescPtr <- xkbAllocKeyboard         status <- xkbGetNames dpy xkbSymbolsNameMask kbdDescPtr         str <- getLayoutStr' status dpy kbdDescPtr-        xkbFreeNames kbdDescPtr xkbGroupNamesMask 1+        xkbFreeNames kbdDescPtr xkbSymbolsNameMask 1         xkbFreeKeyboard kbdDescPtr 0 1         return str @@ -319,3 +322,23 @@         else -- Behaviour on error             do                 return "Error while requesting layout!"++getGrpNames :: Display -> IO [String]+getGrpNames dpy =  do+        kbdDescPtr <- xkbAllocKeyboard+        status <- xkbGetNames dpy xkbGroupNamesMask kbdDescPtr+        str <- getGrpNames' status dpy kbdDescPtr+        xkbFreeNames kbdDescPtr xkbGroupNamesMask 1+        xkbFreeKeyboard kbdDescPtr 0 1+        return str++getGrpNames' :: Status -> Display -> (Ptr XkbDescRec) -> IO [String]+getGrpNames' st dpy kbdDescPtr =+        if st == 0 then -- Success+            do+            kbdDesc <- peek kbdDescPtr+            nameArray <- peek (names kbdDesc)+            let grpsArr = groups nameArray+            let grps = takeWhile (/=none) grpsArr+            mapM (peekCString <=< xGetAtomName dpy) grps+        else return ["Error while requesting layout!"]
src/Xmobar/X11/Window.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Window--- Copyright   :  (c) 2011-18, 20 Jose A. Ortega Ruiz+-- Copyright   :  (c) 2011-18, 20, 21 Jose A. Ortega Ruiz --             :  (c) 2012 Jochen Keil -- License     :  BSD-style (see LICENSE) --@@ -80,9 +80,11 @@   case p' of     Top -> Rectangle rx ry rw h     TopP l r -> Rectangle (rx + fi l) ry (rw - fi l - fi r) h+    TopH ch -> Rectangle rx ry rw (mh ch)     TopW a i -> Rectangle (ax a i) ry (nw i) h     TopSize a i ch -> Rectangle (ax a i) ry (nw i) (mh ch)     Bottom -> Rectangle rx ny rw h+    BottomH ch -> Rectangle rx ny rw (mh ch)     BottomW a i -> Rectangle (ax a i) ny (nw i) h     BottomP l r -> Rectangle (rx + fi l) ny (rw - fi l - fi r) h     BottomSize a i ch  -> Rectangle (ax a i) (ny' ch) (nw i) (mh ch)@@ -153,10 +155,12 @@   case p of     OnScreen _ p'   -> getStrutValues r p' rwh     Top             -> [0, 0, st,  0, 0, 0, 0, 0, nx, nw,  0,  0]+    TopH    _       -> [0, 0, st,  0, 0, 0, 0, 0, nx, nw,  0,  0]     TopP    _ _     -> [0, 0, st,  0, 0, 0, 0, 0, nx, nw,  0,  0]     TopW    _ _     -> [0, 0, st,  0, 0, 0, 0, 0, nx, nw,  0,  0]     TopSize      {} -> [0, 0, st,  0, 0, 0, 0, 0, nx, nw,  0,  0]     Bottom          -> [0, 0,  0, sb, 0, 0, 0, 0,  0,  0, nx, nw]+    BottomH _       -> [0, 0,  0, sb, 0, 0, 0, 0,  0,  0, nx, nw]     BottomP _ _     -> [0, 0,  0, sb, 0, 0, 0, 0,  0,  0, nx, nw]     BottomW _ _     -> [0, 0,  0, sb, 0, 0, 0, 0,  0,  0, nx, nw]     BottomSize   {} -> [0, 0,  0, sb, 0, 0, 0, 0,  0,  0, nx, nw]
test/Xmobar/Plugins/Monitors/CommonSpec.hs view
@@ -13,7 +13,7 @@ spec =   describe "Common.padString" $ do     it "returns given string when called with default values" $-      do padString 0 0 "" False "" "test" `shouldBe` "test"+      padString 0 0 "" False "" "test" `shouldBe` "test"      it "truncates to max width" $ do       let maxw = 3@@ -27,3 +27,9 @@           ellipsis = "..."           expectedStr = (++ ellipsis) . take 3 $ givenStr       padString 0 maxw "" False ellipsis givenStr `shouldBe` expectedStr++    it "does not pad empty strings" $ do+      let padChars = " "+          givenStr = ""+          expectedStr = ""+      padString 0 0 padChars False "" givenStr `shouldBe` expectedStr
xmobar.cabal view
@@ -1,5 +1,5 @@ name:               xmobar-version:            0.38+version:            0.39 homepage:           http://xmobar.org synopsis:           A Minimalistic Text Based Status Bar description: 	    Xmobar is a minimalistic text based status bar.@@ -92,6 +92,10 @@   description: Enable weather plugin.   default: True +flag with_kraken+  description: Enable Kraken plugin.+  default: False+ library     default-language: Haskell2010     hs-source-dirs:  src@@ -149,6 +153,7 @@                    Xmobar.Plugins.Monitors.Common.Parsers,                    Xmobar.Plugins.Monitors.Common.Files,                    Xmobar.Plugins.Monitors.CoreTemp,+                   Xmobar.Plugins.Monitors.K10Temp,                    Xmobar.Plugins.Monitors.CpuFreq,                    Xmobar.Plugins.Monitors.Disk,                    Xmobar.Plugins.Monitors.Mem,@@ -168,7 +173,7 @@     ghc-options: -funbox-strict-fields -Wall -fno-warn-unused-do-bind      build-depends:-      base >= 4.11.0 && < 4.15,+      base >= 4.11.0 && < 4.16,       containers,       regex-compat,       process,@@ -272,6 +277,16 @@        other-modules: Xmobar.Plugins.Monitors.UVMeter        build-depends: http-conduit, http-types        cpp-options: -DUVMETER++    if flag(with_kraken)+      other-modules: Xmobar.Plugins.Kraken+      build-depends: aeson == 1.5.6.*+                   , text == 1.2.4.*+                   , unordered-containers == 0.2.14.*+                   , vector == 0.12.3.*+                   , wuss == 1.1.*+                   , websockets == 0.12.*+      cpp-options: -DKRAKEN      if os(freebsd)        -- enables freebsd specific code