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 }
|]