fedi/app/Html.hs
2024-11-04 11:20:05 +02:00

143 lines
4.1 KiB
Haskell

module Html where
import Css (css)
import Data.Char (isAlpha, ord)
import Data.String (fromString)
import Data.Text qualified as T
import Fedi qualified as Fedi
import Lucid qualified as H
import Text.RawString.QQ (r)
-- * HTML
type Html = H.Html ()
adminPage :: Fedi.UserDetails -> [Fedi.Note] -> Html
adminPage details notes =
template (T.pack $ Fedi.fullmention details) do
userHtml details
newNoteHtml details
notesHtml notes
actorPage :: Fedi.UserDetails -> [Fedi.Note] -> Html
actorPage details notes =
template (T.pack $ Fedi.fullmention details) do
userHtml details
notesHtml notes
-- | HTML boilerplate template
template :: T.Text -> Html -> Html
template title content =
H.doctypehtml_ $ do
H.head_ $ do
H.meta_ [H.charset_ "utf-8"]
H.meta_ [H.name_ "viewport", H.content_ "width=device-width initial_scale=1.0"]
H.title_ (H.toHtml $ "Fediserve - " <> title)
H.style_ css
H.body_ $ do
H.div_ [H.class_ "main"] $ do
content
H.footer_ ""
userHtml :: Fedi.UserDetails -> Html
userHtml details = do
H.div_ [H.class_ "user-details"] do
H.a_ [H.href_ (T.pack $ "/" <> details.username)] $
H.img_ [H.class_ "avatar", H.src_ (T.pack details.icon)]
H.div_ [H.class_ "user-details-details"] do
H.h2_ (fromString details.username)
H.a_ [H.href_ (T.pack $ Fedi.actorUrl details)] $
H.p_ (fromString $ Fedi.fullmention details)
H.p_ (fromString details.summary)
notesHtml :: [Fedi.Note] -> Html
notesHtml notes = do
H.div_ [H.class_ "notes"] $ mapM_ noteHtml notes
H.script_ $ T.pack localDateJs
-- | A single post as HTML.
noteHtml :: Fedi.Note -> Html
noteHtml note = do
let noteid = T.pack (maybe "" (\i -> i.unwrap) note.id)
H.div_ [H.class_ "note"] $ do
H.div_ [H.class_ "note-header"] $ do
case note.name of
Just (Fedi.StringName title) ->
H.h2_ [H.class_ (checkDirection $ T.pack title)] (fromString title)
_ -> pure ()
case note.url of
Just url ->
H.p_ $ H.a_ [H.href_ (T.pack url)] $ fromString url
Nothing -> pure ()
Fedi.for_ note.published \published ->
H.a_
[ H.href_ noteid
, H.class_ "note-time"
, H.title_ "See note page"
]
(H.span_ [H.class_ $ "note-date-published"] $ H.toHtml (show published))
H.div_ [H.class_ $ "note-content " <> checkDirection (maybe "" id note.content)] $ do
H.toHtmlRaw (maybe "" id note.content)
checkDirection :: T.Text -> T.Text
checkDirection txt =
case T.uncons $ T.dropWhile (\c -> not (isAlpha c) && c /= '<') txt of
Just ('<', rest) -> checkDirection (T.dropWhile (/= '>') rest)
Just (c, _) | ord 'א' <= ord c && ord c <= ord 'ת' -> "rtl"
_ -> "ltr"
-- | A new post form.
newNoteHtml :: Fedi.UserDetails -> Html
newNoteHtml details = do
H.form_
[ H.method_ "post"
, H.action_ ("/" <> T.pack details.username <> "/admin/new")
, H.class_ "new-note"
]
( do
H.div_ [H.class_ "new-note-div"] $
H.input_
[ H.class_ "new-note-text"
, H.autofocus_
, H.type_ "text"
, H.name_ "title"
, H.placeholder_ "A title (optional)"
]
H.div_ [H.class_ "new-note-div"] $
H.textarea_
[ H.class_ "new-note-content"
, H.name_ "content"
, H.placeholder_ "Yes?"
]
""
H.div_ [H.class_ "new-note-div"] $
H.input_
[ H.class_ "new-note-text"
, H.type_ "url"
, H.name_ "url"
, H.placeholder_ "A URL this note should link to (optional)"
]
H.div_ [H.class_ "new-note-div"] $
H.input_
[ H.class_ "new-note-submit"
, H.type_ "submit"
, H.title_ "Add a new note"
, H.value_ "Post"
]
)
localDateJs :: String
localDateJs = [r|
let collection = document.querySelectorAll(".note-date-published");
for (let i = 0; i < collection.length; i++) {
let date = new Date(collection[i].innerHTML);
collection[i].innerHTML = date.toLocaleString();
}
|]