module Utils.Pandoc where

import Data.List qualified as List
import Relude
import Text.Pandoc.Definition
import Text.Pandoc.Walk (query)

trimWhiteInlines :: [Inline] -> [Inline]
trimWhiteInlines =
  List.dropWhile isWhite .
  List.dropWhileEnd isWhite
  where
  isWhite Space = True
  isWhite SoftBreak = True
  isWhite _ = False

{-
renderPandocBlock :: B.Block -> H.Html
renderPandocBlock = \case
  B.BlockQuote bs ->
    H.blockquote $ forM_ bs renderPandocBlock
  B.BulletList bss ->
    H.ul ! A.class_ (listStyle <> " list-disc") $
      forM_ bss $ \bs ->
        H.li ! A.class_ listItemStyle $ forM_ bs renderPandocBlock
  B.CodeBlock (id', classes, attrs) s ->
    -- Prism friendly classes
    let classes' = flip List.concatMap classes $ \classes -> [classes, "language-" <> classes]
     in H.div
          ! A.class_ "py-0.5 text-sm"
          $ H.pre
            ! renderPandocAttr (id', classes', attrs)
            $ H.code
              ! renderPandocAttr ("", classes', [])
              $ H.text s
  B.DefinitionList defs ->
    H.dl $
      forM_ defs $ \(term, descList) -> do
        forM_ term renderPandocInline
        forM_ descList $ \desc ->
          H.dd $ forM_ desc renderPandocBlock
  B.Div attr bs ->
    H.div ! renderPandocAttr attr $ forM_ bs renderPandocBlock
  B.Header level attr is ->
    renderHeader level ! renderPandocAttr attr $ do
      fromString $ show attr
      forM_ is renderPandocInline
  B.HorizontalRule -> H.hr
  B.LineBlock iss ->
    forM_ iss $ \is ->
      forM_ is renderPandocInline >> "\n"
  B.Null -> pure ()
  B.OrderedList _ bss ->
    H.ol ! A.class_ (listStyle <> " list-decimal") $
      forM_ bss $ \bs ->
        H.li ! A.class_ listItemStyle $
          forM_ bs renderPandocBlock
  B.Para is ->
    H.p ! A.class_ "my-2" $ forM_ is renderPandocInline
  B.Plain is ->
    forM_ is renderPandocInline
  B.RawBlock (B.Format fmt) html
    | fmt == "html" -> H.unsafeByteString $ encodeUtf8 html
    | otherwise -> throw Unsupported
  B.Table{} ->
    throw Unsupported
  where
    listStyle = "list-inside ml-2 space-y-1 "
    listItemStyle = ""

renderHeader :: Int -> H.Html -> H.Html
renderHeader = \case
  1 -> H.h1 ! classes ("text-xl":cs)
  2 -> H.h2 ! classes ("text-xl":cs)
  3 -> H.h3 ! classes ("text-lg":cs)
  4 -> H.h4 ! classes ("text-lg":cs)
  5 -> H.h5 ! classes ("text-lg":cs)
  6 -> H.h6 ! classes ("text-lg":cs)
  _ -> error "Invalid pandoc header level"
  where
    cs = ["mt-4", "mb-2", "font-bold"]

renderPandocInline :: B.Inline -> H.Html
renderPandocInline = \case
  B.Code attr s ->
    H.code ! renderPandocAttr attr $ H.toHtml s
  B.Emph is ->
    H.em $ forM_ is renderPandocInline
  B.Image attr is (url, title) ->
    H.img ! A.src (H.textValue url) ! A.title (H.textValue title) ! A.alt (H.textValue $ Markdown.plainify is) ! renderPandocAttr attr
  B.Link attr is (url, title) -> do
    let (classes, target) =
          if "://" `T.isInfixOf` url
            then ("text-blue-600 hover:underline", targetBlank)
            else ("text-blue-600 hover:bg-blue-50", mempty)
    H.a
      ! A.class_ classes
      ! A.href (H.textValue url)
      ! A.title (H.textValue title)
      ! target
      ! renderPandocAttr attr
      $ forM_ is renderPandocInline
  B.LineBreak -> H.br
  B.Math _ _ ->
    throw Unsupported
  B.Note _ ->
    throw Unsupported
  B.Quoted qt is ->
    flip inQuotes qt $ forM_ is renderPandocInline
  B.RawInline _fmt s ->
    H.pre $ H.toHtml s
  B.SoftBreak -> " "
  B.Space -> " "
  B.Span attr is ->
    H.span ! renderPandocAttr attr $ forM_ is renderPandocInline
  B.Str s -> H.toHtml s
  B.Strikeout is ->
    H.del $ forM_ is renderPandocInline
  B.Strong is ->
    H.strong $ forM_ is renderPandocInline
  B.Subscript is ->
    H.sub $ forM_ is renderPandocInline
  B.Superscript is ->
    H.sup $ forM_ is renderPandocInline
  B.Underline is ->
    H.u $ forM_ is renderPandocInline
  x ->
    H.pre $ H.toHtml $ show @Text x
  where
    inQuotes :: H.Html -> B.QuoteType -> H.Html
    inQuotes w = \case
      B.SingleQuote -> "‘" >> w <* "’"
      B.DoubleQuote -> "“" >> w <* "”"

targetBlank :: H.Attribute
targetBlank = A.target "_blank" <> A.rel "noopener"

renderPandocAttr :: B.Attr -> H.Attribute
renderPandocAttr (id_, classes, attrs) =
  unlessNull id_ (A.id (H.textValue id_))
    <> unlessNull class_ (A.class_ (H.textValue class_))
    <> foldMap (\(k, v) -> H.dataAttribute (H.textTag k) (H.textValue v)) attrs
  where
    class_ = T.intercalate " " classes
    unlessNull x f
      | T.null x = mempty
      | otherwise = f

data Unsupported = Unsupported
  deriving (Show, Exception)
-}