add initial cli

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
   ];

dev/cli-run.sh

@@ -0,0 +1,3 @@
+cd "$(dirname "$0")"
+
+DBUS_SYSTEM_BUS_ADDRESS=unix:path=/tmp/tuxclocker-dbus-socket ../inst/bin/tuxclocker

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',

src/meson.build

@@ -50,3 +50,7 @@ endif
 if get_option('gui')
 	subdir('tuxclocker-qt')
 endif
+
+if get_option('cli')
+	subdir('tuxclocker-cli')
+endif

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

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))

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