wip

hbs2-peer/app/Browser/Root.hs

@@ -4,15 +4,28 @@ module Browser.Root
   ) where
 
 import HBS2.Prelude.Plated
+import HBS2.Base58
+import HBS2.Net.Proto.Types
+import HBS2.Peer.Proto.RefChan
 
-import Lucid (Html,HtmlT)
+import Data.Config.Suckless.Syntax
-import Lucid.Html5
-import Text.InterpolatedString.Perl6 (qc,qq,q)
-import Control.Monad
-import Control.Monad.Identity
 
-browserRootPage :: Monad m => HtmlT m ()
+import Data.Maybe
-browserRootPage = do
+import Lucid (Html,HtmlT,toHtml)
+import Lucid.Html5 hiding (for_)
+import Data.Text qualified as Text
+import Text.InterpolatedString.Perl6 (q)
+import System.FilePath
+
+
+rootPath :: [String] -> [String]
+rootPath = ("/browser":)
+
+path :: [String] -> Text
+path = Text.pack . joinPath . rootPath
+
+rootPage :: Monad m => HtmlT m () -> HtmlT m ()
+rootPage content  = do
   head_ $ do
     meta_ [charset_ "utf-8"]
     meta_ [name_ "viewport", content_ "width=device-width, initial-scale=1"]
@@ -21,28 +34,85 @@ browserRootPage = do
     link_ [rel_ "stylesheet", href_ "/css/custom.css"]
 
     style_ [type_ "text/css"]  [q|
-      .flex-container { display: flex; justify-content: space-around; }
+      /* jopakita */
-      .flex-item { margin: 10px; padding: 20px; border: 1px solid #ccc; }
+      body, html {
-      .resource-box { box-shadow: 0 4px 8px rgba(0, 0, 0, 0.1); margin: 20px; padding: 20px; border-radius: 8px; }
+        height: 100%;
-      h2 { font-size: 1.00rem; };
+        margin: 0;
-      .container header h2 { font-color: red; }
+      }
+      .root {
+        display: flex;
+        flex-direction: column;
+        min-height: 100vh;
+      }
+      main {
+        flex-grow: 1;
+      }
+      .flex-container {
+        display: flex;
+        justify-content: space-around;
+      }
+      .flex-item {
+        margin: 10px;
+        padding: 20px;
+        border: 1px solid #ccc;
+      }
+      .resource-box {
+        box-shadow: 0 4px 8px rgba(0, 0, 0, 0.1);
+        margin: 4px;
+        padding: 20px;
+        border-radius: 8px;
+      }
+
+      h2 {
+        font-size: 1.15rem;
+      };
+
       |]
 
   body_ $ do
-    div_ [class_ "container"] $ do
+    div_ [class_ "container root"] $ do
 
       header_ $ do
         h1_ "hbs2-peer browser"
 
-      main_ $ do
+      main_ content
 
-        replicateM_ 6 do
+      footer_ [class_ "footer"]"hbs2-peer by hbs2.net 2024"
 
-          div_ [class_ "resource-box"] $ do
+
-            h2_ "Metadata channel"
+browserRootPage :: Monad m => [Syntax c] -> HtmlT m ()
+browserRootPage syn = rootPage do
+
+  let bro = mconcat [ [b] | ListVal [ SymbolVal "browser", b ] <- syn ]
+
+  let channels = [ mchan | ListVal (SymbolVal "meta-channel" : mchan) <- bro ]
+
+  for_ channels $ \chan -> do
+
+    let title = headDef "unknown" [ t
+                                      | ListVal [ SymbolVal "title", LitStrVal t ] <- chan
+                                      ]
+    let desc = mconcat [ d
+                       | ListVal (SymbolVal "description" : d) <- chan
+                       ] & take 5
+
+    let rchan = headMay $ catMaybes
+                        [ fromStringMay @(RefChanId L4Proto) (Text.unpack rc)
+                        | ListVal [SymbolVal "refchan", LitStrVal rc] <- chan
+                        ]
+
+    for_ rchan $ \r -> do
+
+      let rcs = show $ pretty (AsBase58 r)
+
+      div_ [class_ "resource-box"] do
+        h2_ ( "Channel: "  <> toHtml title)
         div_ do
-              a_ [href_ "/wtf"] "5GnroAC8FXNRL8rcgJj6RTu9mt1AbuNd5MZVnDBcCKzb"
+          a_ [href_ (path ["channel", rcs])] (toHtml rcs)
-              p_ "some-shitty-wtf"
+
+          p_ mempty
+
+          for_ [ s | LitStrVal s <- desc ] $ \s -> do
+            p_ (toHtml s)
 
-      footer_ "Это подвал страницы."
 

hbs2-peer/app/HttpWorker.hs

@@ -87,18 +87,6 @@ httpWorker (PeerConfig syn) pmeta e = do
   let bro   = runReader (cfgValue @PeerBrowser) syn == FeatureOn
   penv <- ask
 
-  let tpl = templates
-
-
-  tpls <- for tpl $ \(n,bs) -> do
-    let txt = Enc.decodeUtf8 (LBS.fromStrict bs)
-    tpl <- compileMustacheText (fromString n) txt
-             & orThrowUser [qc|Can't compile template {n}|]
-    debug $ green "TEMPLATE" <+> pretty n
-    pure (n, tpl)
-
-  let templates = HM.fromList tpls
-
   maybe1 port' none $ \port -> liftIO do
 
     scotty port $ do
@@ -227,7 +215,7 @@ httpWorker (PeerConfig syn) pmeta e = do
       when bro do
 
         get "/browser" do
-          renderTextT browserRootPage >>= html
+          renderTextT (browserRootPage syn) >>= html
 
       put "/" do
         -- FIXME: optional-header-based-authorization