From c9bc59a5eea26b2010efb5f5bac72eed4185790f Mon Sep 17 00:00:00 2001 From: Dmitry Zuikov Date: Wed, 3 Apr 2024 05:39:45 +0300 Subject: [PATCH] wip --- .../lib/HBS2/Git/Oracle/Run.hs | 21 +++++++++++++------ 1 file changed, 15 insertions(+), 6 deletions(-) diff --git a/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Run.hs b/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Run.hs index db06fbd9..cc1b53ea 100644 --- a/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Run.hs +++ b/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Run.hs @@ -31,6 +31,9 @@ import Data.ByteString.Lazy (ByteString) import Data.Maybe import Lens.Micro.Platform hiding ( (.=) ) +import Lucid.Base hiding (for_) +import Lucid.Html5 hiding (for_,select_) + import Control.Applicative import Data.Aeson as Aeson import Data.Aeson.Encode.Pretty qualified as A @@ -45,7 +48,6 @@ import Data.HashMap.Strict qualified as HM import Data.ByteString.Lazy qualified as LBS import System.Process.Typed import Text.InterpolatedString.Perl6 (qc) -import System.Environment (getProgName, getArgs) import System.Environment import System.Posix.Signals import System.FilePath @@ -55,6 +57,10 @@ import System.Exit {- HLINT ignore "Functor law" -} +withParams :: [Text] -> PluginMethod -> PluginMethod +withParams ps (Method p a) = createPluginMethod p (HM.toList a <> pa) + where pa = zipWith (\n s -> ([qc|_{n}|],s)) [1..] ps + runOracleIndex :: forall m . MonadUnliftIO m => PubKey 'Sign HBS2Basic -> Oracle m () @@ -214,10 +220,10 @@ instance (MonadUnliftIO m, HasOracleEnv m) => HandleMethod m RpcChannelQuery whe case cmd of ("debug":_) -> listEnv req - ("list-entries":_) -> listEntries req - ("repo" : _) -> renderRepo req - ("/":_) -> listEntries req [] -> listEntries req + ("list-entries":_) -> listEntries req + ("/":_) -> listEntries req + ("repo" : params) -> renderRepo (withParams params req) _ -> pure Nothing where @@ -253,8 +259,11 @@ instance (MonadUnliftIO m, HasOracleEnv m) => HandleMethod m RpcChannelQuery whe _ -> formatJson items - renderRepo _ = do - pure $ Just "

REPO

" + renderRepo (Method _ kw) = do + Just <$> renderBST do + main_ do + let repoRef = fromMaybe "unknown" $ HM.lookup "_1" kw + h1_ $ toHtml $ "REPO " <> repoRef formatJson items = do let root = object [ "rows" .= items