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