{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns      #-}
-- | Render analyzed tokens into HTML table.
module Render.HTML(htmlFromColSpans, htmlInline) where

import Prelude hiding(span, id)
import Data.Text(Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import Text.Blaze.Html5
    ( toHtml,
      Html,
      ToValue(toValue),
      (!),
      b,
      html,
      i,
      span,
      table,
      tbody,
      td,
      tr )
import Text.Blaze.Html5.Attributes(colspan, style, id)
import Text.Blaze.Html.Renderer.Text(renderHtml)

import Alignment ( Align(..) )
import Render.Common(TokensWithColSpan)
import Token        (MyTok(..))
import Util ( preformatTokens, unbrace )

-- | Given a list of lists of colspans in each table row, return an HTML text.
htmlFromColSpans :: [[TokensWithColSpan]]
                 ->   Text
htmlFromColSpans :: [[TokensWithColSpan]] -> Text
htmlFromColSpans =
    LazyText -> Text
LT.toStrict
  (LazyText -> Text)
-> ([[TokensWithColSpan]] -> LazyText)
-> [[TokensWithColSpan]]
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MarkupM () -> LazyText
renderHtml
  (MarkupM () -> LazyText)
-> ([[TokensWithColSpan]] -> MarkupM ())
-> [[TokensWithColSpan]]
-> LazyText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MarkupM () -> MarkupM ()
table
  (MarkupM () -> MarkupM ())
-> ([[TokensWithColSpan]] -> MarkupM ())
-> [[TokensWithColSpan]]
-> MarkupM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MarkupM () -> MarkupM ()
tbody
  (MarkupM () -> MarkupM ())
-> ([[TokensWithColSpan]] -> MarkupM ())
-> [[TokensWithColSpan]]
-> MarkupM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TokensWithColSpan] -> MarkupM ())
-> [[TokensWithColSpan]] -> MarkupM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [TokensWithColSpan] -> MarkupM ()
renderTr

-- | Given a list of colspans within a single table row, render it to HTML tree
--   of `<tr/>` element
renderTr :: [TokensWithColSpan] -> Html
renderTr :: [TokensWithColSpan] -> MarkupM ()
renderTr [TokensWithColSpan]
colspans = MarkupM () -> MarkupM ()
tr ((TokensWithColSpan -> MarkupM ())
-> [TokensWithColSpan] -> MarkupM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TokensWithColSpan -> MarkupM ()
renderColSpan [TokensWithColSpan]
colspans)

-- | Render single colspan as a single `<td/>` cell.
renderColSpan :: TokensWithColSpan -> Html
renderColSpan :: TokensWithColSpan -> MarkupM ()
renderColSpan ([(MyTok
TBlank, Text
txt)], Int
colSpan, Align
AIndent) = -- indentation
    MarkupM () -> MarkupM ()
td (Text -> MarkupM ()
forall a. ToMarkup a => a -> MarkupM ()
toHtml Text
txt)
       MarkupM () -> Attribute -> MarkupM ()
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
colspan (Int -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue Int
colSpan)
       MarkupM () -> Attribute -> MarkupM ()
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
style   AttributeValue
widthStyle
  where
    widthStyle :: AttributeValue
widthStyle = String -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (String -> AttributeValue) -> String -> AttributeValue
forall a b. (a -> b) -> a -> b
$ String
"min-width: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Text -> Int
T.length Text
txt) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"ex"
renderColSpan ([(MyTok, Text)]
toks, Int
colSpan, Align
alignment) =
    MarkupM () -> MarkupM ()
td ([(MyTok, Text)] -> MarkupM ()
formatTokens [(MyTok, Text)]
toks)
       MarkupM () -> Attribute -> MarkupM ()
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
colspan (Int -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue Int
colSpan)
       MarkupM () -> Attribute -> MarkupM ()
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
style   AttributeValue
alignStyle
  where
    alignStyle :: AttributeValue
alignStyle        = AttributeValue
"text-align: " AttributeValue -> AttributeValue -> AttributeValue
forall a. Semigroup a => a -> a -> a
<> Align -> AttributeValue
forall {a}. IsString a => Align -> a
alignMark Align
alignment
    alignMark :: Align -> a
alignMark Align
ACenter = a
"center"
    alignMark Align
ALeft   = a
"left"
    alignMark Align
AIndent = a
"left"

-- TODO: braced operators
-- | Given a list of tokens in a colspan, render HTML fragment.
htmlInline :: [(MyTok, Text)] -> Text
htmlInline :: [(MyTok, Text)] -> Text
htmlInline  = LazyText -> Text
LT.toStrict
            (LazyText -> Text)
-> ([(MyTok, Text)] -> LazyText) -> [(MyTok, Text)] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MarkupM () -> LazyText
renderHtml
            (MarkupM () -> LazyText)
-> ([(MyTok, Text)] -> MarkupM ()) -> [(MyTok, Text)] -> LazyText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(MyTok, Text)] -> MarkupM ()
formatTokens

formatTokens :: [(MyTok, Text)] -> Html
formatTokens :: [(MyTok, Text)] -> MarkupM ()
formatTokens = ((MyTok, Text) -> MarkupM ()) -> [(MyTok, Text)] -> MarkupM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (MyTok, Text) -> MarkupM ()
formatToken
             ([(MyTok, Text)] -> MarkupM ())
-> ([(MyTok, Text)] -> [(MyTok, Text)])
-> [(MyTok, Text)]
-> MarkupM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(MyTok, Text)] -> [(MyTok, Text)]
forall {b}. (Eq b, IsString b) => [(MyTok, b)] -> [(MyTok, b)]
preformatTokens

-- | Format a single token as HTML fragment.
formatToken :: (MyTok, Text) -> Html
formatToken :: (MyTok, Text) -> MarkupM ()
formatToken (MyTok
TOperator,Text -> Maybe Text
unbrace -> Just Text
op) = do MarkupM ()
"("
                                                (MyTok, Text) -> MarkupM ()
formatToken (MyTok
TOperator, Text
op)
                                                MarkupM ()
")"
formatToken (MyTok
TOperator,Text
"|>"       ) = MarkupM ()
"⊳"
formatToken (MyTok
TOperator,Text
"<>"       ) = MarkupM ()
"⋄"
formatToken (MyTok
TOperator,Text
"=>"       ) = MarkupM ()
"⇒"
formatToken (MyTok
TOther,   Text
"="        ) = MarkupM ()
"＝"
formatToken (MyTok
TOperator,Text
"->"       ) = MarkupM ()
"→"
formatToken (MyTok
TOperator,Text
"|->"      ) = MarkupM ()
"↦"
formatToken (MyTok
TVar     ,Text
"undefined") = MarkupM ()
"⊥"
formatToken (MyTok
TVar     ,Text
"bot"      ) = MarkupM ()
"⊥"
formatToken (MyTok
TVar     ,Text
"not"      ) = MarkupM ()
"¬"
formatToken (MyTok
TVar     ,Text
"a"        ) = MarkupM ()
"α"
formatToken (MyTok
TVar     ,Text
"b"        ) = MarkupM ()
"β"
formatToken (MyTok
TVar     ,Text
"c"        ) = MarkupM ()
"γ"
formatToken (MyTok
TVar     ,Text
"d"        ) = MarkupM ()
"δ"
formatToken (MyTok
TVar     ,Text
"pi"       ) = MarkupM ()
"π"
formatToken (MyTok
TVar     ,Text
"eps"      ) = MarkupM ()
"ε"
formatToken (MyTok
TKeyword ,Text
"\\"       ) = MarkupM ()
"λ"
formatToken (MyTok
TKeyword, Text
"forall"   ) = MarkupM ()
"∀"
formatToken (MyTok
TOperator,Text
"elem"     ) = MarkupM ()
"∈"
formatToken (MyTok
TOperator,Text
"<="       ) = MarkupM ()
"≤"
formatToken (MyTok
TOperator,Text
">="       ) = MarkupM ()
"≥"
formatToken (MyTok
TOperator,Text
"mempty"   ) = MarkupM ()
"∅"
formatToken (MyTok
TOperator,Text
">>>"      ) = MarkupM ()
"⋙"
formatToken (MyTok
TOperator,Text
"<<<"      ) = MarkupM ()
"⋘"
formatToken (MyTok
TOperator,Text
"||"       ) = MarkupM ()
"∥"
formatToken (MyTok
TOperator,Text
"<->"      ) = MarkupM ()
"↔︎"
formatToken (MyTok
TOperator,Text
"<-"       ) = MarkupM ()
"←"
formatToken (MyTok
TOperator,Text
"-<"       ) = MarkupM ()
"≺"
formatToken (MyTok
TOperator,Text
">-"       ) = MarkupM ()
"≻"
formatToken (MyTok
TOperator,Text
"!="       ) = MarkupM ()
"≠"
formatToken (MyTok
TOperator,Text
"=="       ) = MarkupM ()
"="
formatToken (MyTok
TOperator,Text
"="        ) = MarkupM ()
"＝"
formatToken (MyTok
TOperator,Text
"\\/"      ) = MarkupM ()
"⋁"
formatToken (MyTok
TOperator,Text
"/\\"      ) = MarkupM ()
"⋀"
formatToken (MyTok
TOperator,Text
"~"        ) = MarkupM ()
"∼"
formatToken (MyTok
TOperator,Text
"~="       ) = MarkupM ()
"≈"
formatToken (MyTok
TVar,     Text
"top"      ) = MarkupM ()
"⊤"
formatToken (MyTok
TKeyword,  Text
kwd       ) = MarkupM () -> MarkupM ()
b (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ Text -> MarkupM ()
forall a. ToMarkup a => a -> MarkupM ()
toHtml Text
kwd
formatToken (MyTok
TVar,      Text
v         ) = MarkupM () -> MarkupM ()
i (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ Text -> MarkupM ()
forall a. ToMarkup a => a -> MarkupM ()
toHtml Text
v
formatToken (MyTok
TCons,     Text
v         ) = MarkupM () -> MarkupM ()
span (Text -> MarkupM ()
forall a. ToMarkup a => a -> MarkupM ()
toHtml Text
v)
                                      MarkupM () -> Attribute -> MarkupM ()
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
style AttributeValue
"font-variant: small-caps;"
formatToken (TTikz Text
mark,Text
_         ) = MarkupM () -> MarkupM ()
span MarkupM ()
""
                                      MarkupM () -> Attribute -> MarkupM ()
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
id (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue Text
mark)
formatToken (MyTok
_,         Text
txt       ) = Text -> MarkupM ()
forall a. ToMarkup a => a -> MarkupM ()
toHtml Text
txt