From 485d0647772a116e25f8c6fd5ac42e4b5ee8581b Mon Sep 17 00:00:00 2001
From: Jussi Kuokkanen <jussi.kuokkanen@protonmail.com>
Date: Fri, 22 Dec 2023 14:24:40 +0200
Subject: [PATCH] add initial cli

---
 default.nix                         |  4 ++-
 dev/cli-run.sh                      |  3 +++
 meson_options.txt                   |  2 ++
 src/meson.build                     |  4 +++
 src/tuxclocker-cli/Main.hs          | 42 +++++++++++++++++++++++++++++
 src/tuxclocker-cli/meson.build      |  3 +++
 src/tuxclocker-cli/tuxclocker.cabal | 10 +++++++
 7 files changed, 67 insertions(+), 1 deletion(-)
 create mode 100755 dev/cli-run.sh
 create mode 100644 src/tuxclocker-cli/Main.hs
 create mode 100644 src/tuxclocker-cli/meson.build
 create mode 100644 src/tuxclocker-cli/tuxclocker.cabal

diff --git a/default.nix b/default.nix
index 51923b7..794498e 100644
--- a/default.nix
+++ b/default.nix
@@ -3,8 +3,9 @@
 , boost
 , cmake
 , cudatoolkit
-, git
 , fetchFromGitHub
+, git
+, haskellPackages
 , libdrm
 , libX11
 , libXext
@@ -40,6 +41,7 @@ mkDerivation rec {
   '';
 
   nativeBuildInputs = [
+    (haskellPackages.ghcWithPackages (p: with p; [ dbus ]))
     git
     pkg-config
   ];
diff --git a/dev/cli-run.sh b/dev/cli-run.sh
new file mode 100755
index 0000000..4f1aba5
--- /dev/null
+++ b/dev/cli-run.sh
@@ -0,0 +1,3 @@
+cd "$(dirname "$0")"
+
+DBUS_SYSTEM_BUS_ADDRESS=unix:path=/tmp/tuxclocker-dbus-socket ../inst/bin/tuxclocker
diff --git a/meson_options.txt b/meson_options.txt
index a03fb5e..7df61d0 100644
--- a/meson_options.txt
+++ b/meson_options.txt
@@ -4,6 +4,8 @@ option('daemon', type: 'boolean', value: 'true', description: 'Build daemon')
 option('plugins', type: 'boolean', value: 'true', description: 'Build plugins')
 option('library', type: 'boolean', value: 'true', description: 'Build library')
 option('gui', type: 'boolean', value: 'true', description: 'Build Qt GUI')
+# Disabled by default to not break builds
+option('cli', type: 'boolean', value: 'false', description: 'Build CLI')
 option('require-python-hwdata', type: 'boolean', value: 'false',
 	description: 'Require python-hwdata for prettier AMD GPU names')
 option('require-amd', type: 'boolean', value: 'false',
diff --git a/src/meson.build b/src/meson.build
index 0f70b8f..ff4906e 100644
--- a/src/meson.build
+++ b/src/meson.build
@@ -50,3 +50,7 @@ endif
 if get_option('gui')
 	subdir('tuxclocker-qt')
 endif
+
+if get_option('cli')
+	subdir('tuxclocker-cli')
+endif
diff --git a/src/tuxclocker-cli/Main.hs b/src/tuxclocker-cli/Main.hs
new file mode 100644
index 0000000..8fba979
--- /dev/null
+++ b/src/tuxclocker-cli/Main.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import Data.Either
+import Data.Functor
+import Data.Maybe
+import Data.Text (Text)
+import DBus
+import DBus.Client
+import qualified DBus.Introspection as I
+
+tuxClockerCall :: MethodCall -> MethodCall
+tuxClockerCall call = call { methodCallDestination = Just "org.tuxclocker" }
+
+getObject :: Client -> ObjectPath -> IO I.Object
+getObject client path = do
+  reply <- call_ client $
+    tuxClockerCall $ methodCall path "org.freedesktop.DBus.Introspectable" "Introspect"
+  let xml = fromVariant (head $ methodReturnBody reply)
+  pure $ fromMaybe
+    (error ("Invalid introspection XML: " ++ show xml))
+    (xml >>= I.parseXML path)
+
+getName :: Client -> ObjectPath -> IO Variant
+getName client path =
+  let
+    call = tuxClockerCall $ methodCall path "org.tuxclocker.Node" "name"
+  in
+    getProperty client call <&> fromRight (toVariant ("Unnamed" :: Text))
+
+printDBusTree :: Client -> IO ()
+printDBusTree client =
+  go client "/" where
+    go client path = do
+      object <- getObject client path
+      print $ I.objectPath object
+      name <- getName client $ I.objectPath object
+      print name
+      mapM_ (go client) (I.objectPath <$> I.objectChildren object)
+
+main = do
+  client <- connectSystem
+  printDBusTree client
diff --git a/src/tuxclocker-cli/meson.build b/src/tuxclocker-cli/meson.build
new file mode 100644
index 0000000..fea4968
--- /dev/null
+++ b/src/tuxclocker-cli/meson.build
@@ -0,0 +1,3 @@
+install_dir = join_paths(get_option('prefix'), get_option('bindir'))
+
+run_command('cabal', 'install', '--installdir=@0@'.format(install_dir))
diff --git a/src/tuxclocker-cli/tuxclocker.cabal b/src/tuxclocker-cli/tuxclocker.cabal
new file mode 100644
index 0000000..da2b1af
--- /dev/null
+++ b/src/tuxclocker-cli/tuxclocker.cabal
@@ -0,0 +1,10 @@
+name: tuxclocker
+version: 0.0.1
+cabal-version: 2.0
+build-type: Simple
+
+executable tuxclocker
+  build-depends: base >= 4.16,
+                 dbus >= 1.2,
+                 text >= 2.0
+  main-is: Main.hs