{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Literate.Document.HTML (
  module Literate.Document.HTML,
  module Text.Blaze.Html5,
  module Text.Blaze.Renderer.Utf8,
)
where

import Data.Char qualified as Char
import Data.List qualified as List
import Data.Map.Strict qualified as Map
import Data.Text qualified as Text
import Data.Text.Short qualified as ShortText
import Literate.Document.Table
import Literate.Document.Type
import Literate.Prelude
import Text.Blaze
import Text.Blaze.Html5
import Text.Blaze.Html5.Attributes qualified as HA
import Text.Blaze.Renderer.Utf8
import Prelude qualified

instance IsString AttributeValue
instance IsString Html

classes :: [String] -> Attribute
classes cls =
  HA.class_ $
    cls
      & List.filter (not . null)
      <&> toValue
      & List.intersperse " "
      & mconcat

className :: Show a => a -> String
className x =
  x & show & List.map \c ->
    if Char.isAlphaNum c
      then c
      else '-'

type CSSBlock = Map String String

styles :: CSSBlock -> Attribute
styles kvs =
  HA.style $
    [ toValue k <> ":" <> toValue v <> ";"
    | (k, v) <- kvs & Map.toList
    , not (null v)
    ]
      & mconcat

type CSS = Map [String] CSSBlock
styleCSS :: CSS -> Markup
styleCSS m =
  style
    ! HA.type_ "text/css"
    $ [ mconcat [n <> " {" | n <- ns]
        <> "\n"
        <> List.unlines
          [ k <> ":" <> v <> ";"
          | (k, v) <- kvs & Map.toList
          , not (null v)
          ]
        <> mconcat [" }" | _n <- ns]
        <> "\n"
      | (ns, kvs) <- m & Map.toList
      , kvs & null & not
      ]
      & List.unlines
      & toMarkup

class ToCSS a where
  toCSS :: a -> String

instance ToMarkup ShortText where
  toMarkup = ShortText.toText >>> toMarkup
  preEscapedToMarkup = ShortText.toText >>> preEscapedToMarkup

instance ToCSS Text where
  toCSS = Text.unpack

instance ToCSS Length where
  toCSS = \case
    LengthAbsolute x -> x & toCSS
    LengthRelative x -> x & toCSS
instance ToCSS LengthAbsolute where
  toCSS = \case
    LengthAbsoluteMillimeters x -> show x <> "mm"
instance ToCSS LengthRelative where
  toCSS = \case
    LengthRelativeFractionalRatio x -> show x <> "fr"
    LengthRelativeMaxContent -> "max-content"
    LengthRelativeMinContent -> "min-content"

cssPageWidth = \case
  PageOrientationLandscape -> 29.7 & cm
  PageOrientationPortrait -> 21.0 & cm
cssPageHeight = \case
  PageOrientationLandscape -> 21.0 & cm
  PageOrientationPortrait -> 29.7 & cm
cssPageSize = \case
  PageSizeA5 -> "A5"
  PageSizeA4 -> "A4"
  PageSizeA4Plus -> "A4plus"
  PageSizeA3 -> "A3"
cssPageOrientation = \case
  PageOrientationPortrait -> "portrait"
  PageOrientationLandscape -> "landscape"

cssPrintPage :: PageOrientation -> PageSize -> CSS
cssPrintPage pageOrient pageSize =
  [
    [ ["@page"] :=
        [ "size" :=
            List.unwords
              [ cssPageSize pageSize
              , cssPageOrientation pageOrient
              ]
        ]
    ]
  ]
    & mconcat

cssBlockObjectFitCover :: CSSBlock
cssBlockObjectFitCover = ["object-fit" := "cover"]

instance ToMarkup Blocks where
  toMarkup = foldMap toMarkup . unBlocks
instance ToMarkup Block where
  toMarkup = \case
    BlockDiv x -> div $ x & toMarkup
    BlockFlex x -> x & toMarkup
    BlockPara (Inlines x) -> p $ x & foldMap toMarkup
    BlockTable x -> x & toMarkup
instance ToMarkup Inline where
  toMarkup = \case
    InlineText x -> x & toMarkup
instance ToMarkup FlexItem where
  toMarkup itm =
    forM_ (itm & flexItemContent) toMarkup
instance ToMarkup Flex where
  toMarkup flx =
    div
      ! styles
        [ "display" := "flex"
        , "flex-direction" := flx & flexDirection & toCSS
        , "gap" := flx & flexGap & toCSS
        ]
      $ do
        forM_ (flx & flexItems) toMarkup

instance ToMarkup Table where
  toMarkup tbl =
    div
      ! classes ["table"]
      ! styles ["grid-template-columns" := tbl & tableTemplateFinal <&> toCSS & List.unwords]
      $ do
        forM_ (tbl & tableHeads) \hd -> do
          div ! classes ["table-head"] $ do
            forM_ (hd & tableHeadColumns) \cel -> do
              div ! classes ["table-cell"] $ do
                div do
                  cel & tableCellContent & toMarkup
        forM_ (tbl & tableRows & ol1) \(rowCount, row) -> do
          div ! classes ["table-body", if even rowCount then "even" else "odd"] $ do
            forM_ (row & tableRowColumns) \cel -> do
              div
                ! classes ["table-cell"]
                ! styles ["justify-items" := cel & tableCellJustify & toCSS]
                $ do
                  cel & tableCellContent & toMarkup
instance ToMarkup Dict where
  toMarkup dic =
    div
      ! classes ["dict"]
      $ do
        forM_ (dic & dictEntries) \(key, val) ->
          div ! classes ["dict-entry"] $ do
            div ! classes ["dict-key"] $ do
              key & toMarkup
            div ! classes ["dict-value"] $ do
              val & toMarkup
instance ToCSS Justification where
  toCSS = \case
    JustificationLeft -> "left"
    JustificationBegin -> "begin"
    JustificationCenter -> "center"
    JustificationEnd -> "end"
    JustificationRight -> "right"
instance ToCSS FlexDirection where
  toCSS = \case
    FlexDirectionColumn -> "column"
    FlexDirectionRow -> "row"