{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      : System.Taffybar.Widget.FSMonitor
-- Copyright   : (c) José A. Romero L.
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : José A. Romero L. <escherdragon@gmail.com>
-- Stability   : unstable
-- Portability : unportable
--
-- Simple text widget that monitors the current usage of selected disk
-- partitions by regularly parsing the output of the df command in Linux
-- systems.
--
-----------------------------------------------------------------------------

module System.Taffybar.Widget.FSMonitor ( fsMonitorNew ) where

import           Control.Monad.IO.Class
import qualified GI.Gtk
import           System.Process ( readProcess )
import           System.Taffybar.Widget.Generic.PollingLabel ( pollingLabelNew )
import qualified Data.Text as T

-- | Creates a new filesystem monitor widget. It contains one 'PollingLabel'
-- that displays the data returned by the df command. The usage level of all
-- requested partitions is extracted in one single operation.
fsMonitorNew
  :: MonadIO m
  => Double -- ^ Polling interval (in seconds, e.g. 500)
  -> [String] -- ^ Names of the partitions to monitor (e.g. [\"\/\", \"\/home\"])
  -> m GI.Gtk.Widget
fsMonitorNew :: Double -> [String] -> m Widget
fsMonitorNew Double
interval [String]
fsList = IO Widget -> m Widget
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Widget -> m Widget) -> IO Widget -> m Widget
forall a b. (a -> b) -> a -> b
$ do
  Widget
label <- Double -> IO Text -> IO Widget
forall (m :: * -> *). MonadIO m => Double -> IO Text -> m Widget
pollingLabelNew Double
interval (IO Text -> IO Widget) -> IO Text -> IO Widget
forall a b. (a -> b) -> a -> b
$ [String] -> IO Text
showFSInfo [String]
fsList
  Widget -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
GI.Gtk.widgetShowAll Widget
label
  Widget -> IO Widget
forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
GI.Gtk.toWidget Widget
label

showFSInfo :: [String] -> IO T.Text
showFSInfo :: [String] -> IO Text
showFSInfo [String]
fsList = do
  String
fsOut <- String -> [String] -> String -> IO String
readProcess String
"df" (String
"-kP"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
fsList) String
""
  let fss :: [[String]]
fss = (String -> [String]) -> [String] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
2 ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words) ([String] -> [[String]]) -> [String] -> [[String]]
forall a b. (a -> b) -> a -> b
$ Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
fsOut
  Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((\String
s -> String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]") (String -> String) -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords) [[String]]
fss