module HBS2.Git.Oracle.Html where import HBS2.Git.Oracle.Prelude import HBS2.Git.Oracle.State import HBS2.Peer.HTTP.Root import HBS2.Peer.Proto.BrowserPlugin import Data.HashMap.Strict (HashMap) import Lucid hiding (for_) import Lucid.Base import Lucid.Html5 hiding (for_) import Data.Text (Text) import Data.Text qualified as Text import Data.Word import Data.List qualified as List import Data.HashMap.Strict qualified as HM import Data.ByteString.Lazy 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 html <- writeHtml5String def {writerExtensions = pandocExtensions} doc return $ Text.unpack html renderMarkdown :: Text -> Html () renderMarkdown markdown = case markdownToHtml markdown of Left{} -> mempty Right html -> toHtmlRaw $ Text.pack html -- -- -- -- -- -- -- FIXME: move-to-hbs2-browser-lib hyper_ :: Text -> Attribute hyper_ = makeAttribute "_" -- FIXME: move-to-hbs2-browser-lib onClickCopy :: Text -> Attribute onClickCopy s = hyper_ [qc|on click writeText('{s}') into the navigator's clipboard add .clicked to me wait 2s remove .clicked from me|] renderEntries :: Monad m => PluginMethod -> [(HashVal, Text, Text, Word64)] -> m ByteString renderEntries (Method _ kw) items = pure $ renderBS do -- TODO: ugly let hrefBase = HM.lookup "URL_PREFIX" kw & List.singleton . maybe "/" Text.unpack wrapped do main_ do section_ do h1_ "Git repositories" form_ [class_ "search"] do input_ [type_ "search", id_ "search"] button_ [class_ "search"] mempty section_ [id_ "repo-search-results"] do for_ items $ \(h,n,b,t) -> do let s = if Text.length n > 2 then n else "unnamed" let refpart = Text.take 8 $ Text.pack $ show $ pretty h let sref = show $ pretty h let ref = Text.pack sref let suff = ["repo", sref] let url = path (hrefBase <> suff) div_ [class_ "repo-list-item"] do div_ [class_ "repo-info"] do h2_ [class_ "xclip", onClickCopy ref] $ toHtml (s <> "-" <> refpart) p_ $ a_ [href_ url] (toHtml ref) renderMarkdown b where -- 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