142 lines
3.1 KiB
Haskell
142 lines
3.1 KiB
Haskell
module Html where
|
|
|
|
import Data.String (fromString)
|
|
import Data.Char (ord, isAlpha)
|
|
import Data.Text qualified as T
|
|
import Lucid qualified as H
|
|
import Text.RawString.QQ
|
|
|
|
import Fedi qualified as Fedi
|
|
|
|
-- * HTML
|
|
|
|
type Html = H.Html ()
|
|
|
|
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
|
|
|
|
-- | A single post as HTML.
|
|
noteHtml :: Fedi.Note -> Html
|
|
noteHtml note = do
|
|
H.div_ [ H.class_ "note" ] $ do
|
|
H.div_ [ H.class_ "note-header" ] $ do
|
|
H.a_
|
|
[ H.href_ (T.pack note.id)
|
|
, H.class_ "note-time"
|
|
, H.title_ "See note page"
|
|
]
|
|
(H.toHtml (T.pack (show note.published)))
|
|
|
|
H.div_ [H.class_ $ "note-content " <> checkDirection note.content] $ do
|
|
H.toHtmlRaw 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"
|
|
|
|
-- * CSS
|
|
|
|
css :: T.Text
|
|
css = [r|
|
|
body {
|
|
margin: 40px auto;
|
|
max-width: 650px;
|
|
line-height: 1.6;
|
|
font-size: 18px;
|
|
color: #e2d2bf;
|
|
background-color: #0f0f15;
|
|
padding: 0 10px;
|
|
}
|
|
|
|
a { color: #f79226; }
|
|
a:hover { color: #ffcd56; }
|
|
|
|
.user-details {
|
|
display: flex;
|
|
background-color: #081829;
|
|
color: #e2d2bf;
|
|
border: 1px solid #fecb87;
|
|
}
|
|
.user-details a { color: #ffa95e; }
|
|
.user-details a:hover { color: #ffcd56; }
|
|
|
|
.user-details * {
|
|
margin: 10px;
|
|
}
|
|
|
|
.user-details-details * {
|
|
margin: 0px;
|
|
}
|
|
|
|
footer {
|
|
margin-top: 50px;
|
|
margin-bottom: 20px;
|
|
border-top: 1px solid #fecb87;
|
|
}
|
|
|
|
.note-header {
|
|
border-top: 1px solid #888;
|
|
margin-top: 20px;
|
|
padding-top: 20px;
|
|
text-align: center;
|
|
}
|
|
|
|
.avatar {
|
|
width: 100px;
|
|
height: 100px;
|
|
border-radius: 10px;
|
|
border: 1px solid #fecb87;
|
|
margin: 0px;
|
|
}
|
|
|
|
img {
|
|
max-width: 100%;
|
|
display: block;
|
|
}
|
|
|
|
h1,h2,h3 {
|
|
line-height:1.2
|
|
}
|
|
dd {
|
|
margin-right: 12px;
|
|
margin-left: 12px;
|
|
margin-bottom: 20px;
|
|
}
|
|
.ltr { direction: ltr }
|
|
.rtl { direction: rtl }
|
|
|]
|