-----------------------------------------------------------------------------
-- |
-- Module      :  Plugins.Monitors.CatInt
-- Copyright   :  (c) Nathaniel Wesley Filardo
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Nathaniel Wesley Filardo
-- Stability   :  unstable
-- Portability :  unportable
--
-----------------------------------------------------------------------------

module Xmobar.Plugins.Monitors.CatInt where

import Xmobar.Plugins.Monitors.Common

catIntConfig :: IO MConfig
catIntConfig :: IO MConfig
catIntConfig = String -> [String] -> IO MConfig
mkMConfig String
"<v>" [String
"v"]

runCatInt :: FilePath -> [String] -> Monitor String
runCatInt :: String -> [String] -> Monitor String
runCatInt String
p [String]
_ =
  let failureMessage :: String
failureMessage = String
"Cannot read: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
p
      fmt :: a -> String
fmt a
x = Int -> String
forall a. Show a => a -> String
show (a -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate a
x :: Int)
  in  String
-> [[String]]
-> Maybe (String, String -> Int)
-> (Double -> Double)
-> (Double -> String)
-> Monitor String
forall a.
(Ord a, Num a) =>
String
-> [[String]]
-> Maybe (String, String -> Int)
-> (Double -> a)
-> (a -> String)
-> Monitor String
checkedDataRetrieval String
failureMessage [[String
p]] Maybe (String, String -> Int)
forall a. Maybe a
Nothing Double -> Double
forall a. a -> a
id Double -> String
forall a. RealFrac a => a -> String
fmt