wip

hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Html.hs

@@ -32,17 +32,46 @@ renderMarkdown markdown = case markdownToHtml markdown of
 renderEntries :: Monad m => HashMap Text Text -> [(HashVal, Text, Text, Word64)] -> m ByteString
 renderEntries args items = pure $ renderBS do
   wrapped do
-    for_ items $ \(h,n,b,t) -> do
-      div_ [class_ "resource-box"] do
 
-        let name = if Text.length n > 2 then toHtml n else toHtml (show $ pretty h)
+    div_ [class_ "container main"] $ do
+      nav_ [class_ "left"] $ do
+        div_ [class_ "info-block"] "Всякая разная рандомная информация хрен знает, что тут пока выводить"
+        div_ [class_ "info-block"] "Всякая разная рандомная информация хрен знает, что тут пока выводить"
 
-        h3_ [class_ "repo-name"] name
+      main_ do
 
-        div_ [class_ "repo-brief"] do
+        div_ [class_ "container"] do
-          renderMarkdown b
 
-        div_ [class_ "repo-reference"] $ a_ [] (toHtml (show $ pretty h))
+          section_ do
+            h1_ "Git repositories"
+            form_ [class_ "search"] do
+                input_ [type_ "search", id_ "search"]
+                button_ "apply"
+
+
+          section_ [id_ "repo-search-results"] do
+
+            for_ items $ \(h,n,b,t) -> do
+
+              -- let name = if Text.length n > 2 then toHtml (n <> "-" <>) else toHtml (show $ pretty h)
+
+              let name = mempty
+
+              div_ [class_ "repo-list-item"] do
+                div_ [class_ "repo-info"] do
+                  h2_ $ a_ [href_ ""] name
+
+                  a_ [href_ ""] (toHtml (show $ pretty h))
+
+                  renderMarkdown b
+
+
+                -- h3_ [class_ "repo-name"] name
+
+                -- div_ [class_ "repo-brief"] do
+                --   renderMarkdown b
+
+                -- div_ [class_ "repo-reference"] $ a_ [] (toHtml (show $ pretty h))
 
   where
 

hbs2-peer/app/Browser/Root.hs

@@ -32,6 +32,7 @@ path = Text.pack . joinPath . rootPath
 
 myCss :: Monad m => HtmlT m ()
 myCss = style_ $ [q|
+
 input, button  {
   font-size: var(--form-element-font-size);
   height: 2rem;
@@ -144,6 +145,17 @@ div .repo-list-item {
   border: 1px solid #BFC7D9;
 }
 
+.channel-list-item {
+  display: block;
+
+  background: #FAFAFA;
+  padding: 0.75rem;
+  margin-top: 1.75rem;
+  border-radius: 0.25rem;
+  border: 1px solid #BFC7D9;
+
+}
+
 .repo-info, .repo-info-misc {
   flex: 1;
 }
@@ -197,11 +209,18 @@ rootPage :: Monad m => HtmlT m () -> HtmlT m ()
 rootPage content  = do
   doctypehtml_ do
     head_ do
+      meta_ [charset_ "UTF-8"]
+      meta_ [name_ "viewport", content_ "width=device-width, initial-scale=1.0"]
+      -- link_ [rel_ "stylesheet", href_"/css/pico.min.css"]
+      link_ [rel_ "stylesheet", href_ "https://cdn.jsdelivr.net/npm/@picocss/pico@2.0.6/css/pico.min.css"]
       myCss
 
     body_ do
+      header_ do
+        div_ [class_ "header-title"] $ strong_ "hbs2-peer dashboard"
       content
 
+
 browserRootPage :: Monad m => [Syntax c] -> HtmlT m ()
 browserRootPage syn = rootPage do
 
@@ -209,33 +228,40 @@ browserRootPage syn = rootPage do
 
   let channels = [ mchan | ListVal (SymbolVal "channel" : mchan) <- bro ]
 
-  for_ channels $ \chan -> do
+  div_ [class_ "container main"] $ do
+    nav_ [class_ "left"] $ do
+      div_ [class_ "info-block"] "Всякая разная рандомная информация хрен знает, что тут пока выводить"
+      div_ [class_ "info-block"] "Всякая разная рандомная информация хрен знает, что тут пока выводить"
 
-    let title = headDef "unknown" [ t
+    main_ do
-                                      | ListVal [ SymbolVal "title", LitStrVal t ] <- chan
+      for_ channels $ \chan -> do
-                                      ]
-    let desc = mconcat [ d
-                       | ListVal (SymbolVal "description" : d) <- chan
-                       ] & take 5
 
-    let rchan = headMay $ catMaybes
+        let title = headDef "unknown" [ t
-                        [ fromStringMay @(RefChanId L4Proto) (Text.unpack rc)
+                                          | ListVal [ SymbolVal "title", LitStrVal t ] <- chan
-                        | ListVal [SymbolVal "refchan", LitStrVal rc] <- chan
+                                          ]
-                        ]
+        let desc = mconcat [ d
+                           | ListVal (SymbolVal "description" : d) <- chan
+                           ] & take 5
 
-    for_ rchan $ \r -> do
+        let rchan = headMay $ catMaybes
+                            [ fromStringMay @(RefChanId L4Proto) (Text.unpack rc)
+                            | ListVal [SymbolVal "refchan", LitStrVal rc] <- chan
+                            ]
 
-      let rcs = show $ pretty (AsBase58 r)
 
-      div_ [class_ "resource-box"] do
+        for_ rchan $ \r -> do
-        h2_ ( "Channel: "  <> toHtml title)
-        div_ do
-          a_ [href_ (path ["channel", rcs])] (toHtml rcs)
 
-          p_ mempty
+          let rcs = show $ pretty (AsBase58 r)
 
-          for_ [ s | LitStrVal s <- desc ] $ \s -> do
+          section_ do
-            p_ (toHtml s)
+
+            div_ [class_ "channel-list-item"] do
+              h2_ $ toHtml title
+
+              a_ [href_ (path ["channel", rcs])] (toHtml rcs)
+
+              for_ [ s | LitStrVal s <- desc ] $ \s -> do
+                p_ (toHtml s)
 
 
 channelPage :: MonadIO m