[ui]: initial proof of concept interface using butler

flake.nix

@@ -26,14 +26,17 @@
       "github:NixOS/nixpkgs/ed014c27f4d0ca772fb57d3b8985b772b0503bbd";
     hspkgs.url =
       "github:podenv/hspkgs/e25ca08431a6bab2b9eccda1764269824fe786ea";
+    butler.url =
+      "github:TristanCacqueray/haskell-butler/235aa40e2d6ef2c33ca9f82a62dfd901cdbd4ae5";
   };
 
-  outputs = { self, nixpkgs, hspkgs }:
+  outputs = { self, nixpkgs, hspkgs, butler }:
     let
       legacy = import ./nix/default.nix {
         nixpkgsPath = nixpkgs;
         hspkgs = hspkgs.pkgs;
         self = self;
+        butler = butler;
       };
     in {
       haskellExtend = legacy.hExtend;

monocle.cabal

@@ -128,6 +128,7 @@ library
                      , binary                     >= 0.8
                      , bloodhound                 ^>= 0.19
                      , bugzilla-redhat            ^>= 1.0
+                     , butler
                      , byteslice                  >= 0.2
                      , bytestring                 >= 0.10
                      , containers                 >= 0.6
@@ -213,6 +214,9 @@ library
                      , CLI
                      , Tests
 
+                     -- butler
+                     , Monocle.Butler
+
                      -- monocle api
                      , Monocle.Entity
                      , Monocle.Main

nix/default.nix

@@ -1,4 +1,4 @@
-{ elasticsearch-port ? 19200, nixpkgsPath, hspkgs, self }:
+{ elasticsearch-port ? 19200, nixpkgsPath, hspkgs, butler, self }:
 let
   nixpkgsSrc = import nixpkgsPath;
 
@@ -44,7 +44,7 @@ let
     config.allowUnfree = true;
   };
   # final haskell set, see: https://github.com/NixOS/nixpkgs/issues/25887
-  hsPkgs = hspkgs.hspkgs.extend haskellExtend;
+  hsPkgs = (hspkgs.hspkgs.extend butler.haskellExtend).extend haskellExtend;
 
   # manually adds build dependencies for benchmark and codegen that are not managed by cabal2nix
   addExtraDeps = drv:

src/Monocle/Butler.hs

@@ -0,0 +1,46 @@
+-- | This module contains the new monocle app
+module Monocle.Butler where
+
+import Butler
+import Prelude
+
+import Monocle.Backend.Queries qualified as Q
+import Monocle.Effects qualified as E
+import Monocle.Env qualified as M
+import Monocle.Logging qualified as E (runLoggerEffect)
+import Monocle.Prelude (runEff)
+
+-- Here is a demo app that only display the current change count.
+-- Given a elasticEnv, we can unwrap the effectful Eff context into butler's ProcessIO
+dashboardApp :: E.ElasticEnv -> App
+dashboardApp elasticEnv = defaultApp "dashboard" startDashboard
+ where
+  runEffects = liftIO . runEff . E.runLoggerEffect . E.runElasticEffect elasticEnv . E.runMonoQuery queryEnv
+
+  startDashboard ctx = do
+    state <- newTVarIO 0
+    let getChanges = runEffects do
+          -- Here is the demo of using the monocle backend:
+          count <- Q.countDocs
+          atomically do writeTVar state count
+
+    -- make a query
+    getChanges
+
+    let mountUI = with div_ [wid_ ctx.wid "w"] do
+          "Change count: "
+          count <- lift do readTVar state
+          toHtml (showT count)
+
+    forever do
+      atomically (readPipe ctx.pipe) >>= \case
+        ae@AppDisplay {} -> sendHtmlOnConnect mountUI ae
+        _ -> pure ()
+
+  -- TODO: make this configurable by the user.
+  queryEnv :: E.MonoQueryEnv
+  queryEnv =
+    E.MonoQueryEnv
+      { queryTarget = M.QueryWorkspace (M.mkConfig "openstack")
+      , searchQuery = undefined
+      }