diff --git a/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Facts.hs b/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Facts.hs index 5c77d173..5ae10457 100644 --- a/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Facts.hs +++ b/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/Facts.hs @@ -25,7 +25,7 @@ data GitRepoExtended = newtype GitLwwRef = GitLwwRef (LWWRefKey HBS2Basic) deriving stock (Generic,Data) - deriving newtype (ToField) + deriving newtype (ToField,FromField) newtype GitLwwSeq = GitLwwSeq Word64 deriving stock (Generic,Data) @@ -46,15 +46,15 @@ newtype GitTx = GitTx HashRef newtype GitRepoHeadRef = GitRepoHeadRef HashRef deriving stock (Generic,Data) - deriving newtype (ToField) + deriving newtype (ToField,FromField) newtype GitName = GitName (Maybe Text) deriving stock (Generic,Data) - deriving newtype (ToField) + deriving newtype (ToField,FromField) newtype GitBrief = GitBrief (Maybe Text) deriving stock (Generic,Data) - deriving newtype (ToField) + deriving newtype (ToField,FromField) newtype GitManifest = GitManifest (Maybe Text) deriving stock (Generic,Data) 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 62e2554a..b634ea6d 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 @@ -26,6 +26,8 @@ import Text.Pandoc import Text.Pandoc.Error (handleError) import Text.InterpolatedString.Perl6 (qc) + + markdownToHtml :: Text -> Either PandocError String markdownToHtml markdown = runPure $ do doc <- readMarkdown def {readerExtensions = pandocExtensions} markdown @@ -100,12 +102,35 @@ wrapped f = do body_ mempty f -renderRepoHtml :: Monad m => PluginMethod -> Maybe GitManifest -> m ByteString -renderRepoHtml (Method _ kw) mf' = pure $ renderBS $ wrapped do +renderRepoHtml :: Monad m => PluginMethod -> GitRepoPage -> m ByteString +renderRepoHtml (Method _ kw) page@(GitRepoPage{..}) = pure $ renderBS $ wrapped do + + let mf = headDef "" [ fromMaybe "" s | GitManifest s <- universeBi page ] + & Text.lines + & List.dropWhile (not . Text.null) + & Text.unlines + + let name' = coerce @_ @(Maybe Text) repoPageName + let brief = coerce @_ @(Maybe Text) repoPageBrief & fromMaybe "" + main_ do - let txt = coerce @_ @(Maybe Text) <$> mf' & join & fromMaybe "" + + section_ [id_ "repo-data"] do + + for_ name' $ \name -> do + h1_ (toHtml name) + renderMarkdown brief + + table_ do + tr_ do + th_ "code/hbs2:" + td_ mempty + + pure () + + section_ [id_ "repo-manifest-text"] do - renderMarkdown txt + renderMarkdown mf 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 d0d2c3d9..40cc5c2c 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 @@ -295,17 +295,21 @@ instance (MonadUnliftIO m, HasOracleEnv m) => HandleMethod m RpcChannelQuery whe debug $ yellow "TWO" - mf' <- lift ( withOracleEnv env do - withState $ select @(HashRef, GitManifest) [qc| - select v.repohead, m.manifest - from vrepofact v join gitrepomanifest m on v.repohead = m.repohead + mf <- lift ( withOracleEnv env do + withState $ select @GitRepoPage [qc| + select v.lwwref + , v.repohead + , v.name + , v.brief + , m.manifest + from vrepofact v left join gitrepomanifest m on v.repohead = m.repohead where v.lwwref = ? limit 1 |] (Only ref) ) <&> headMay - <&> fmap snd + >>= toMPlus - renderRepoHtml req mf' + renderRepoHtml req mf formatJson items = do let root = object [ "rows" .= items diff --git a/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/State.hs b/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/State.hs index 2153bf45..b5f7a6bf 100644 --- a/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/State.hs +++ b/hbs2-git/hbs2-git-oracle/lib/HBS2/Git/Oracle/State.hs @@ -19,6 +19,18 @@ import Data.Coerce import Data.Word import Data.Text qualified as Text +data GitRepoPage = + GitRepoPage + { repoPageRef :: GitLwwRef + , repoPageHead :: GitRepoHeadRef + , repoPageName :: GitName + , repoPageBrief :: GitBrief + , repoPageManifest :: GitManifest + } + deriving stock (Generic,Data) + +instance FromRow GitRepoPage + processedRepoTx :: (LWWRefKey HBS2Basic, HashRef) -> HashVal processedRepoTx w = HashVal $ HashRef $ hashObject @HbSync (serialise w) diff --git a/hbs2-peer/app/Browser/Root.hs b/hbs2-peer/app/Browser/Root.hs index b1bb36c7..36c66706 100644 --- a/hbs2-peer/app/Browser/Root.hs +++ b/hbs2-peer/app/Browser/Root.hs @@ -68,13 +68,15 @@ button.search svg { body, html { margin: 0; height: 100%; - font-size: 18px; + font-size: 20px; } header { width: 100%; + font-size: 20px; + display: flex; align-items: center; @@ -89,7 +91,7 @@ header { /* height: 64px; */ header h1 { - font-size: 1.45rem; + font-size: 20px; margin: 0 0 0 2.21rem; font-weight: 500; } @@ -121,6 +123,7 @@ header a { nav.left { flex: 0 0 20rem; padding: 4rem 0rem 0 1rem; + font-size: 20px; flex-direction: column; justify-content: normal; background: #FAFAFA; @@ -132,6 +135,7 @@ nav.left .info-block { section#repo-manifest-text { width: 60rem; + font-size: 24px; } @@ -253,6 +257,7 @@ form.search input[type="search"] { form.search button { align: center; + min-width: 4rem; } .xclip::after { @@ -295,6 +300,7 @@ rootPage content = do -- 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"] script_ [src_ "https://unpkg.com/hyperscript.org@0.9.12"] "" + script_ [src_ "https://unpkg.com/htmx.org@1.9.11"] "" myCss body_ do