Skip to content

Commit

Permalink
[ui]: initial proof of concept interface using butler
Browse files Browse the repository at this point in the history
  • Loading branch information
TristanCacqueray committed Aug 19, 2023
1 parent b6b114f commit fba25c1
Show file tree
Hide file tree
Showing 5 changed files with 113 additions and 5 deletions.
59 changes: 57 additions & 2 deletions flake.lock

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

5 changes: 4 additions & 1 deletion flake.nix
Original file line number Diff line number Diff line change
Expand Up @@ -26,14 +26,17 @@
"github:NixOS/nixpkgs/ed014c27f4d0ca772fb57d3b8985b772b0503bbd";
hspkgs.url =
"github:podenv/hspkgs/e25ca08431a6bab2b9eccda1764269824fe786ea";
butler.url =
"github:TristanCacqueray/haskell-butler/94af3ff012940511dec2ac62acf830641d636134";
};

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;
Expand Down
4 changes: 4 additions & 0 deletions monocle.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -213,6 +214,9 @@ library
, CLI
, Tests

-- butler
, Monocle.Butler

-- monocle api
, Monocle.Entity
, Monocle.Main
Expand Down
4 changes: 2 additions & 2 deletions nix/default.nix
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
{ elasticsearch-port ? 19200, nixpkgsPath, hspkgs, self }:
{ elasticsearch-port ? 19200, nixpkgsPath, hspkgs, butler, self }:
let
nixpkgsSrc = import nixpkgsPath;

Expand Down Expand Up @@ -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:
Expand Down
46 changes: 46 additions & 0 deletions src/Monocle/Butler.hs
Original file line number Diff line number Diff line change
@@ -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
}

0 comments on commit fba25c1

Please sign in to comment.