{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- | Render a DTC source file in HTML5.
module Language.DTC.Write.HTML5 where

import Control.Monad (forM_, mapM_)
-- import Data.Bool
-- import Data.Eq (Eq(..))
import Data.Foldable (Foldable(..))
import Data.Function (($), (.))
import Data.Functor ((<$>))
import Data.Maybe (Maybe(..))
import Data.Semigroup (Semigroup(..))
import Text.Blaze ((!))
import Text.Blaze.Html (Html)
import qualified Data.List as L
import qualified Data.Text as Text
import qualified Data.Text.Lazy as TL
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes  as HA
import qualified Text.Blaze.Internal as H

import Text.Blaze.Utils

import Language.DTC.Document (Document)
import Language.DTC.Write.XML ()
import qualified Language.DTC.Document as DTC

instance H.ToMarkup DTC.Ident where
	toMarkup (DTC.Ident i) = H.toMarkup i

html5Document :: Document -> Html
html5Document DTC.Document{..} = do
	H.docType
	H.html $ do
		H.head $ do
			H.meta ! HA.httpEquiv "Content-Type"
			       ! HA.content "text/html; charset=UTF-8"
			whenSome (DTC.titles $ DTC.about (head :: DTC.Head)) $ \ts ->
				let t = textHorizontals $ L.head $ (DTC.unTitle <$> ts) <> [[DTC.Plain ""]] in
				H.title $ H.toMarkup t
			-- link ! rel "Chapter" ! title "SomeTitle">
			H.link ! HA.rel "stylesheet"
			       ! HA.type_ "text/css"
			       ! HA.href "style/dtc-html5.css"
		H.body $
			forM_ body html5Body

html5Body :: DTC.Body -> Html
html5Body = \case
	 DTC.Section{..} ->
		html5CommonAttrs attrs $
		H.section $ do
			H.table ! HA.class_ "section-header" $
				H.tbody $
					H.tr $ do
						H.td ! HA.class_ "section-number" $
							"N.N.N"
						H.td ! HA.class_ "section-title" $
							html5Horizontals $ DTC.unTitle title
			forM_ body html5Body
		{- aliases :: [Alias]
		-}
	 DTC.Verticals vs -> html5Verticals vs

html5Verticals :: [DTC.Vertical] -> Html
html5Verticals = foldMap html5Vertical

html5Vertical :: DTC.Vertical -> Html
html5Vertical = \case
	 DTC.Para{..} ->
		html5CommonAttrs attrs $
		H.div ! HA.class_ "para" $
			html5Horizontals horis
	 DTC.OL{..} ->
		html5CommonAttrs attrs $
		H.ol ! HA.class_ "ol" $
			forM_ items $ \item ->
				H.li $ html5Verticals item
	 DTC.UL{..} ->
		html5CommonAttrs attrs $
		H.ul ! HA.class_ "ul" $
			forM_ items $ \item ->
				H.li $ html5Verticals item
	 DTC.RL{..} ->
		html5CommonAttrs attrs $
		H.div ! HA.class_ "rl" $
			H.table $
				forM_ refs html5Reference
	 DTC.Comment t ->
		H.Comment (H.Text t) ()
	 DTC.Figure{..} ->
		html5CommonAttrs attrs $
		H.div ! HA.class_ (attrValue $ "figure-"<>type_) $ do
			H.table ! HA.class_ "figure-caption" $
				H.tbody $
					H.tr $ do
						H.td ! HA.class_ "figure-number" $ do
							H.a ! HA.href "" $ H.toMarkup type_
							": "
						H.td ! HA.class_ "figure-name" $
							html5Horizontals $ DTC.unTitle title
			H.div ! HA.class_ "figure-content" $ do
				html5Verticals verts
	 DTC.ToC{..} ->
		H.nav ! HA.class_ "toc" $ ""
	 DTC.ToF{..} -> 
		H.nav ! HA.class_ "tof" $ ""
	{-
	 Index{..} -> 
	 Artwork{..} -> 
	-}

html5Reference :: DTC.Reference -> Html
html5Reference DTC.Reference{..} =
	H.tr $ do
		H.td ! HA.class_ "reference-key" $
			H.toMarkup id
		H.td ! HA.class_ "reference-content" $
			html5About about

html5About :: DTC.About -> Html
html5About DTC.About{..} =
	forM_ titles $ \(DTC.Title title) -> do
		html5Horizontal $ DTC.Q title
	{-
	authors
	editor
	date
	version
	keywords
	links
	series
	includes
	-}

html5CommonAttrs :: DTC.CommonAttrs -> Html -> Html
html5CommonAttrs DTC.CommonAttrs{..} =
	(case classes of
	 [] -> \x -> x
	 _  -> H.AddCustomAttribute "class" (H.Text $ Text.unwords classes)) .
	case id of
	 Nothing -> \x -> x
	 Just (DTC.Ident i) ->
			H.AddCustomAttribute "id" (H.Text i)

html5Horizontal :: DTC.Horizontal -> Html
html5Horizontal = \case
	 DTC.BR       -> H.br
	 DTC.B    hs  -> H.strong $ html5Horizontals hs
	 DTC.Code hs  -> H.code   $ html5Horizontals hs
	 DTC.Del  hs  -> H.del    $ html5Horizontals hs
	 DTC.I    hs  -> H.i      $ html5Horizontals hs
	 DTC.Note _   -> ""
	 DTC.Q    hs  -> "« "<>H.i (html5Horizontals hs)<>" »"
	 DTC.SC   hs  -> html5Horizontals hs
	 DTC.Sub  hs  -> H.sub $ html5Horizontals hs
	 DTC.Sup  hs  -> H.sup $ html5Horizontals hs
	 DTC.U    hs  -> H.span ! HA.class_ "underline" $ html5Horizontals hs
	 DTC.Eref{..} -> H.a ! HA.class_ "eref" ! HA.href (attrValue href) $ html5Horizontals text
	 DTC.Iref{..} -> H.a ! HA.class_ "iref" ! HA.href (attrValue to)   $ html5Horizontals text
	 DTC.Ref{..}  -> H.a ! HA.class_ "ref"  ! HA.href (attrValue to)   $ html5Horizontals text
	 DTC.Rref{..} -> H.a ! HA.class_ "rref" ! HA.href (attrValue to)   $ html5Horizontals text
	 DTC.Plain t  -> H.toMarkup t

html5Horizontals :: [DTC.Horizontal] -> Html
html5Horizontals = mapM_ html5Horizontal

textHorizontal :: DTC.Horizontal -> TL.Text
textHorizontal = \case
	 DTC.BR       -> "\n"
	 DTC.B    hs  -> "*"<>textHorizontals hs<>"*"
	 DTC.Code hs  -> "`"<>textHorizontals hs<>"`"
	 DTC.Del  hs  -> "-"<>textHorizontals hs<>"-"
	 DTC.I    hs  -> "/"<>textHorizontals hs<>"/"
	 DTC.Note _   -> ""
	 DTC.Q    hs  -> "« "<>textHorizontals hs<>" »"
	 DTC.SC   hs  -> textHorizontals hs
	 DTC.Sub  hs  -> textHorizontals hs
	 DTC.Sup  hs  -> textHorizontals hs
	 DTC.U    hs  -> "_"<>textHorizontals hs<>"_"
	 DTC.Eref{..} -> textHorizontals text
	 DTC.Iref{..} -> textHorizontals text
	 DTC.Ref{..}  -> textHorizontals text
	 DTC.Rref{..} -> textHorizontals text
	 DTC.Plain t  -> TL.fromStrict t

textHorizontals :: [DTC.Horizontal] -> TL.Text
textHorizontals = foldMap textHorizontal