mirror of https://github.com/voidlizard/hbs2
wip
This commit is contained in:
parent
5d056b0be0
commit
c9bc59a5ee
|
|
@ -31,6 +31,9 @@ import Data.ByteString.Lazy (ByteString)
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Lens.Micro.Platform hiding ( (.=) )
|
import Lens.Micro.Platform hiding ( (.=) )
|
||||||
|
|
||||||
|
import Lucid.Base hiding (for_)
|
||||||
|
import Lucid.Html5 hiding (for_,select_)
|
||||||
|
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Data.Aeson as Aeson
|
import Data.Aeson as Aeson
|
||||||
import Data.Aeson.Encode.Pretty qualified as A
|
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 Data.ByteString.Lazy qualified as LBS
|
||||||
import System.Process.Typed
|
import System.Process.Typed
|
||||||
import Text.InterpolatedString.Perl6 (qc)
|
import Text.InterpolatedString.Perl6 (qc)
|
||||||
import System.Environment (getProgName, getArgs)
|
|
||||||
import System.Environment
|
import System.Environment
|
||||||
import System.Posix.Signals
|
import System.Posix.Signals
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
|
|
@ -55,6 +57,10 @@ import System.Exit
|
||||||
|
|
||||||
{- HLINT ignore "Functor law" -}
|
{- 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
|
runOracleIndex :: forall m . MonadUnliftIO m
|
||||||
=> PubKey 'Sign HBS2Basic
|
=> PubKey 'Sign HBS2Basic
|
||||||
-> Oracle m ()
|
-> Oracle m ()
|
||||||
|
|
@ -214,10 +220,10 @@ instance (MonadUnliftIO m, HasOracleEnv m) => HandleMethod m RpcChannelQuery whe
|
||||||
|
|
||||||
case cmd of
|
case cmd of
|
||||||
("debug":_) -> listEnv req
|
("debug":_) -> listEnv req
|
||||||
("list-entries":_) -> listEntries req
|
|
||||||
("repo" : _) -> renderRepo req
|
|
||||||
("/":_) -> listEntries req
|
|
||||||
[] -> listEntries req
|
[] -> listEntries req
|
||||||
|
("list-entries":_) -> listEntries req
|
||||||
|
("/":_) -> listEntries req
|
||||||
|
("repo" : params) -> renderRepo (withParams params req)
|
||||||
_ -> pure Nothing
|
_ -> pure Nothing
|
||||||
|
|
||||||
where
|
where
|
||||||
|
|
@ -253,8 +259,11 @@ instance (MonadUnliftIO m, HasOracleEnv m) => HandleMethod m RpcChannelQuery whe
|
||||||
_ -> formatJson items
|
_ -> formatJson items
|
||||||
|
|
||||||
|
|
||||||
renderRepo _ = do
|
renderRepo (Method _ kw) = do
|
||||||
pure $ Just "<main><h1>REPO</h1></main>"
|
Just <$> renderBST do
|
||||||
|
main_ do
|
||||||
|
let repoRef = fromMaybe "unknown" $ HM.lookup "_1" kw
|
||||||
|
h1_ $ toHtml $ "REPO " <> repoRef
|
||||||
|
|
||||||
formatJson items = do
|
formatJson items = do
|
||||||
let root = object [ "rows" .= items
|
let root = object [ "rows" .= items
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue