diff --git a/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Html.hs b/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Html.hs index 376db944..57997eb6 100644 --- a/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Html.hs +++ b/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Html.hs @@ -32,16 +32,8 @@ 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 - - div_ [class_ "container main"] $ do - nav_ [class_ "left"] $ do - div_ [class_ "info-block"] "Всякая разная рандомная информация хрен знает, что тут пока выводить" - div_ [class_ "info-block"] "Всякая разная рандомная информация хрен знает, что тут пока выводить" - main_ do - div_ [class_ "container"] do - section_ do h1_ "Git repositories" form_ [class_ "search"] do @@ -53,33 +45,25 @@ renderEntries args items = pure $ renderBS 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 + let s = if Text.length n > 2 then n else "unnamed" + let refpart = Text.take 8 $ Text.pack $ show $ pretty h div_ [class_ "repo-list-item"] do div_ [class_ "repo-info"] do - h2_ $ a_ [href_ ""] name + h2_ $ a_ [href_ ""] $ toHtml (s <> "-" <> refpart) 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 - wrapped f | not (HM.member "HTML_WRAPPED" args) = div_ f - | otherwise = do - doctypehtml_ do - head_ mempty do - meta_ [charset_ "utf-8"] + -- wrapped f | not (HM.member "HTML_WRAPPED" args) = div_ f + -- | otherwise = do + wrapped f = do + doctypehtml_ do + head_ mempty do + meta_ [charset_ "utf-8"] - body_ mempty f + body_ mempty f 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 af059092..01e95add 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 @@ -240,7 +240,7 @@ instance (MonadUnliftIO m, HasOracleEnv m) => HandleMethod m RpcChannelQuery whe formatJson items = do let root = object [ "rows" .= items - , "desc" .= [ "entity", "name", "brief" ] + , "desc" .= [ "entity", "name", "brief", "timestamp" ] ] pure $ Just $ A.encodePretty root diff --git a/hbs2-peer/app/Browser/Root.hs b/hbs2-peer/app/Browser/Root.hs index e4366219..cd41695a 100644 --- a/hbs2-peer/app/Browser/Root.hs +++ b/hbs2-peer/app/Browser/Root.hs @@ -19,9 +19,12 @@ import Lucid (Html,HtmlT,toHtml,toHtmlRaw) import Lucid.Html5 hiding (for_) import Data.Text qualified as Text import Text.InterpolatedString.Perl6 (q) +import Data.ByteString.Lazy.Char8 qualified as LBS import System.FilePath import Control.Monad +import Text.HTML.TagSoup + import UnliftIO rootPath :: [String] -> [String] @@ -35,7 +38,7 @@ myCss = style_ $ [q| input, button { font-size: var(--form-element-font-size); - height: 2rem; + height: 2.5rem; padding: 0.25rem 0.5rem; border-radius: 0.25rem; border: 1px solid #ccc; @@ -43,7 +46,7 @@ input, button { input[type="search"] { font-size: var(--form-element-font-size); - height: 2rem; + height: 2.5rem; padding: 0.25rem 0.5rem; border-radius: 0.25rem; border: 1px solid #ccc; @@ -53,6 +56,7 @@ input[type="search"] { body, html { margin: 0; height: 100%; + font-size: 16px; } header { @@ -60,13 +64,21 @@ header { display: flex; align-items: center; - padding: 1rem; + + padding: 8px; top: 0; left: 0; z-index: 100; box-shadow: 0 2px 5px rgba(0,0,0,0.2); - height: 64px; +} + +/* height: 64px; */ + +header h1 { + font-size: 1.45rem; + margin: 0 0 0 2.21rem; + font-weight: 500; } .header-title { @@ -104,13 +116,10 @@ nav.left { main { flex-grow: 1; padding: 2rem 0 0 4rem; - height: calc(100vh - 64px); } -header h1 { - font-size: 16pt; - margin-left: 2rem; -} + +/* height: calc(100vh - 64px); */ section { margin-top: 1rem; @@ -124,11 +133,11 @@ section { } main h1 { - font-size: 24pt; + font-size: 1.5rem; } main h2 { - font-size: 18pt; + font-size: 1.45rem; font-weight: 400; } @@ -160,11 +169,17 @@ div .repo-list-item { flex: 1; } +.repo-info h2 a { + text-decoration: none; + color: inherit; +} + .repo-info-misc { text-align: right; font-size: 0.85rem; } + .attr { display: flex; margin-bottom: 0.5em; @@ -217,7 +232,7 @@ rootPage content = do body_ do header_ do - div_ [class_ "header-title"] $ strong_ "hbs2-peer dashboard" + div_ [class_ "header-title"] $ h1_ "hbs2-peer dashboard" content @@ -275,6 +290,24 @@ channelPage api env' = do <&> join <&> fromMaybe mempty - rootPage $ toHtmlRaw r + let str = LBS.unpack r + rootPage $ do + + div_ [class_ "container main"] $ do + nav_ [class_ "left"] $ do + div_ [class_ "info-block"] "Всякая разная рандомная информация хрен знает, что тут пока выводить" + div_ [class_ "info-block"] "Всякая разная рандомная информация хрен знает, что тут пока выводить" + + main_ do + toHtmlRaw (extractBodyHtml str) + + where + extractBodyHtml :: String -> String + extractBodyHtml html = + let tags = parseTags html + bodyTags = takeWhile (~/= "") . dropWhile (~/= "
") $ tags + -- Убираем начальный и конечный тег , если это необходимо + contentTags = drop 1 $ take (length bodyTags - 1) bodyTags + in renderTags contentTags diff --git a/hbs2-peer/hbs2-peer.cabal b/hbs2-peer/hbs2-peer.cabal index 8f3fe160..cf326d05 100644 --- a/hbs2-peer/hbs2-peer.cabal +++ b/hbs2-peer/hbs2-peer.cabal @@ -51,6 +51,7 @@ common common-deps , stm , streaming , sqlite-simple + , tagsoup , time , temporary , text @@ -209,6 +210,7 @@ test-suite test , serialise , stm , streaming + , tagsoup , tasty , tasty-quickcheck , tasty-hunit