From 27911553f65cd1a6967e7eac9ae9dd64e10dd597 Mon Sep 17 00:00:00 2001
From: Jens Nolte <jens@nightmarestudio.de>
Date: Sun, 20 Sep 2020 23:11:44 +0200
Subject: [PATCH] Implement simple disk usage block based on coreutils `df`

---
 src/QBar/Blocks.hs           |  2 ++
 src/QBar/Blocks/DiskUsage.hs | 31 +++++++++++++++++++++++++++++++
 src/QBar/Cli.hs              |  6 ++++++
 stack.yaml                   |  2 +-
 4 files changed, 40 insertions(+), 1 deletion(-)
 create mode 100644 src/QBar/Blocks/DiskUsage.hs

diff --git a/src/QBar/Blocks.hs b/src/QBar/Blocks.hs
index 54acadb..f95dc27 100644
--- a/src/QBar/Blocks.hs
+++ b/src/QBar/Blocks.hs
@@ -2,6 +2,7 @@ module QBar.Blocks
   ( QBar.Blocks.Battery.batteryBlock,
     QBar.Blocks.CpuUsage.cpuUsageBlock,
     QBar.Blocks.Date.dateBlock,
+    QBar.Blocks.DiskUsage.diskUsageBlock,
     QBar.Blocks.NetworkManager.networkManagerBlock,
     QBar.Blocks.Script.scriptBlock,
     QBar.Blocks.Script.pollScriptBlock,
@@ -11,5 +12,6 @@ where
 import qualified QBar.Blocks.Battery
 import qualified QBar.Blocks.CpuUsage
 import qualified QBar.Blocks.Date
+import qualified QBar.Blocks.DiskUsage
 import qualified QBar.Blocks.NetworkManager
 import qualified QBar.Blocks.Script
diff --git a/src/QBar/Blocks/DiskUsage.hs b/src/QBar/Blocks/DiskUsage.hs
new file mode 100644
index 0000000..a0169b3
--- /dev/null
+++ b/src/QBar/Blocks/DiskUsage.hs
@@ -0,0 +1,31 @@
+module QBar.Blocks.DiskUsage where
+
+import QBar.BlockHelper
+import QBar.BlockOutput
+import QBar.Core
+
+import qualified Data.ByteString.Lazy.Char8 as C8
+import qualified Data.Text.Lazy as T
+import qualified Data.Text.Lazy.Encoding as T
+import System.Exit
+import System.Process.Typed (shell, readProcessStdout)
+
+diskIcon :: T.Text
+diskIcon = "💾\xFE0E"
+
+diskUsageBlock :: Text -> Block
+diskUsageBlock path = runPollBlock $ forever $ do
+  output <- liftBarIO action
+  yieldBlockUpdate $ addIcon diskIcon output 
+  where
+    action :: BarIO BlockOutput
+    action = do
+      (exitCode, output) <- liftIO $ readProcessStdout $ shell $ "df --human-readable --local --output=avail " <> T.unpack path
+      return $ case exitCode of
+        ExitSuccess -> createBlockOutput output
+        (ExitFailure nr) -> mkErrorOutput $ "exit code " <> T.pack (show nr) <> ""
+    createBlockOutput :: C8.ByteString -> BlockOutput
+    createBlockOutput output = case map T.decodeUtf8 (C8.lines output) of
+      [] -> mkErrorOutput $ "no output"
+      [_header] -> mkErrorOutput $ "invalid output"
+      (_header:values) -> mkBlockOutput $ normalText $ T.intercalate " " $ map T.strip values
diff --git a/src/QBar/Cli.hs b/src/QBar/Cli.hs
index d45ca9c..204a473 100644
--- a/src/QBar/Cli.hs
+++ b/src/QBar/Cli.hs
@@ -88,10 +88,16 @@ blockParser =
     command "date" (info (pure $ addBlock dateBlock) (progDesc "Load the date and time block.")) <>
     command "cpu" (info (pure $ addBlock $ cpuUsageBlock 1) (progDesc "Load the cpu usage block.")) <>
     command "battery" (info (pure $ addBlock $ batteryBlock) (progDesc "Load the battery block.")) <>
+    command "disk" (info diskUsageBlockParser (progDesc "Load the disk usage block.")) <>
     command "networkmanager" (info (pure $ addBlock networkManagerBlock) (progDesc "Load the network-manager block.")) <>
     command "script" (info scriptBlockParser (progDesc "Display the output of an external script as a block."))
   )
 
+diskUsageBlockParser :: Parser (BarIO ())
+diskUsageBlockParser = do
+  file <- strArgument (metavar "FILE" <> help "The FILE by which the file system is selected.")
+  return $ addBlock $ diskUsageBlock file
+
 scriptBlockParser :: Parser (BarIO ())
 scriptBlockParser = helper <*> do
   poll <- switch $ long "poll" <> short 'p' <> help "Run script in poll mode (at regular intervals)"
diff --git a/stack.yaml b/stack.yaml
index f7d38b9..f49f409 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -42,7 +42,7 @@ packages:
 # Disable pure nix-shell environment on NixOS, because access to XDG_RUNTIME_DIR is needed for the control socket
 nix:
   pure: false
-  packages: [ zlib ]
+  packages: [ zlib coreutils ]
 
 # Override default flag values for local packages and extra-deps
 # flags: {}
-- 
GitLab