{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hdoc.DTC.Write.HTML5
 ( module Hdoc.DTC.Write.HTML5
 , module Hdoc.DTC.Write.HTML5.Ident
 , module Hdoc.DTC.Write.HTML5.Base
 , module Hdoc.DTC.Write.HTML5.Judgment
 -- , module Hdoc.DTC.Write.HTML5.Error
 ) where

import Control.Applicative (Applicative(..))
import Control.Monad (Monad(..), (=<<), forM_, mapM_, sequence_)
import Data.Bool
import Data.Default.Class (Default(..))
import Data.Either (Either(..))
import Data.Foldable (Foldable(..), concat, any)
import Data.Function (($), (.), const, on)
import Data.Functor ((<$>))
import Data.Functor.Compose (Compose(..))
import Data.IntMap.Strict (IntMap)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Locale hiding (Index)
import Data.Maybe (Maybe(..), maybe, mapMaybe, fromJust, maybeToList, listToMaybe)
import Data.Monoid (Monoid(..))
import Data.Ord (Ord(..))
import Data.Semigroup (Semigroup(..))
import Data.String (String)
import Data.TreeSeq.Strict (Tree(..), tree0)
import Data.Tuple (snd)
import System.FilePath ((</>))
import System.IO (IO)
import Text.Blaze ((!))
import Text.Blaze.Html (Html)
import Text.Show (Show(..))
import qualified Control.Category as Cat
import qualified Control.Monad.Trans.State as S
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as HS
import qualified Data.IntMap.Strict as IntMap
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.Sequence as Seq
import qualified Data.Strict.Maybe as Strict
import qualified Data.Text as Text
import qualified Data.Text.Lazy as TL
import qualified Data.TreeMap.Strict as TreeMap
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes  as HA
import qualified Text.Blaze.Internal as H

import Hdoc.DTC.Document as DTC
import Hdoc.DTC.Write.HTML5.Ident
import Hdoc.DTC.Write.Plain (Plainify(..))
import Hdoc.DTC.Write.XML ()
import Hdoc.Utils
import Control.Monad.Utils
import Text.Blaze.Utils
import qualified Hdoc.DTC.Check as Check
import qualified Hdoc.DTC.Collect as Collect
import qualified Hdoc.DTC.Index as Index
import qualified Hdoc.DTC.Write.Plain as Plain
import qualified Hdoc.TCT.Cell as TCT
import qualified Hdoc.Utils as FS
import qualified Hdoc.XML as XML
import qualified Paths_hdoc as Hdoc
import Hdoc.DTC.Write.HTML5.Base
import Hdoc.DTC.Write.HTML5.Judgment
import Hdoc.DTC.Write.HTML5.Error ()
import Debug.Trace

debug :: Show a => String -> a -> a
debug msg a = trace (msg<>": "<>show a) a
debugOn :: Show b => String -> (a -> b) -> a -> a
debugOn msg get a = trace (msg<>": "<>show (get a)) a
debugWith :: String -> (a -> String) -> a -> a
debugWith msg get a = trace (msg<>": "<>get a) a

writeHTML5 :: Config -> DTC.Document -> IO Html
writeHTML5 conf@Config{..} doc@DTC.Document{..} = do
	let (checkedBody,checkState) =
		let state_collect = Collect.collect doc in
		Check.check body `S.runState` def
		 { Check.state_irefs   = foldMap Index.irefsOfTerms $ Collect.all_index state_collect
		 , Check.state_collect
		 }
	let (html5Body, endState) =
		let Check.State{..} = checkState in
		runComposeState def
		 { state_collect
		 , state_indexs =
			(<$> Collect.all_index state_collect) $ \terms ->
				(terms,) $
				TreeMap.intersection const state_irefs $
				Index.irefsOfTerms terms
		 , state_rrefs
		 , state_notes
		 , state_section  = body
		 , state_l10n     = loqualize config_locale
		 , state_plainify = def{Plain.state_l10n = loqualize config_locale}
		 } $ do
			html5Judgments
			html5ify state_errors
			html5DocumentHead head
			html5ify checkedBody
	html5Head <- writeHTML5Head conf endState head
	return $ do
		let State{..} = endState
		H.docType
		H.html ! HA.lang (attrify $ countryCode config_locale) $ do
			html5Head
			H.body $ do
				{-
				unless (null state_scripts) $ do
					-- NOTE: indicate that JavaScript is active.
					H.script ! HA.type_ "application/javascript" $
						"document.body.className = \"script\";"
				-}
				html5Body

writeHTML5Head :: Config -> State -> Head -> IO Html
writeHTML5Head Config{..} State{..} Head{DTC.about=About{..}} = do
	csss :: Html <-
		-- unless (any (\DTC.Link{..} -> rel == "stylesheet" && href /= URL "") links) $ do
		(`foldMap` state_styles) $ \case
		 Left css -> do
			content <- FS.readFile =<< Hdoc.getDataFileName ("style"</>css)
			return $ H.style ! HA.type_ "text/css" $
				H.toMarkup content
		 Right content ->
			return $ H.style ! HA.type_ "text/css" $
				-- NOTE: as a special case, H.style wraps its content into an External,
				-- so it does not HTML-escape its content.
				H.toMarkup content
			{-
			case config_css of
			 Left "" -> mempty
			 Left css ->
				H.link ! HA.rel "stylesheet"
				       ! HA.type_ "text/css"
				       ! HA.href (attrify css)
			 Right css ->
				H.style ! HA.type_ "text/css" $
					H.toMarkup css
			-}
	scripts :: Html <-
		(`foldMap` state_scripts) $ \script -> do
			content <- FS.readFile =<< Hdoc.getDataFileName ("style"</>script)
			return $ H.script ! HA.type_ "application/javascript" $
				H.toMarkup content
			{-
		if not (any (\DTC.Link{rel} -> rel == "script") links)
		 then do
		 else
			mempty
			case config_js of
			 Left "" -> mempty
			 Left  js -> H.script ! HA.src (attrify js)
			                      ! HA.type_ "application/javascript"
			                      $ mempty
			 Right js -> H.script ! HA.type_ "application/javascript"
			                      $ H.toMarkup js
			-}
	return $
		H.head $ do
			H.meta ! HA.httpEquiv "Content-Type"
			       ! HA.content "text/html; charset=UTF-8"
			unless (null titles) $ do
				H.title $
					H.toMarkup $ Plain.text state_plainify $ List.head titles
			forM_ links $ \Link{..} ->
				case rel of
				 "stylesheet" | URL "" <- href ->
					H.style ! HA.type_ "text/css" $
						H.toMarkup $ Plain.text def plain
				 _ ->
					H.link ! HA.rel (attrify rel)
					       ! HA.href (attrify href)
			forM_ url $ \href ->
				H.link ! HA.rel "self"
				       ! HA.href (attrify href)
			unless (TL.null config_generator) $ do
				H.meta ! HA.name "generator"
				       ! HA.content (attrify config_generator)
			unless (null tags) $
				H.meta ! HA.name "keywords"
				       ! HA.content (attrify $ TL.intercalate ", " tags)
			let chapters =
				(`mapMaybe` toList state_section) $ \case
				 Tree (BodySection s) _ -> Just s
				 _ -> Nothing
			forM_ chapters $ \Section{..} ->
				H.link ! HA.rel "Chapter"
				       ! HA.title (attrify $ plainify section_title)
				       ! HA.href (refIdent $ identify section_posXML)
			csss
			scripts

html5DocumentHead :: Head -> HTML5
html5DocumentHead Head{DTC.about=About{..}, judgments} = do
	st <- liftComposeState S.get
	unless (null authors) $ do
		H.div ! HA.class_ "document-head" $$
			H.table $$ do
				H.tbody $$ do
					H.tr $$ do
						H.td ! HA.class_ "left"  $$ docHeaders
						H.td ! HA.class_ "right" $$ docAuthors
	unless (null titles) $ do
		H.div ! HA.class_ "title"
		      ! HA.id "document-title." $$ do
			forM_ titles $ \title ->
				H.h1 ! HA.id (attrify $ identifyTitle (Plain.state_l10n $ state_plainify st) title) $$
					html5ify title
	do -- judgments
		let sectionJudgments = HS.fromList judgments
		let opinsBySectionByJudgment = state_opinions st `HM.intersection` HS.toMap sectionJudgments
		liftComposeState $ S.modify' $ \s ->
			s{ state_judgments = sectionJudgments
			 , state_opinions  =
				-- NOTE: drop current opinions of the judgments of this section
				HM.unionWith (const List.tail)
				 (state_opinions s)
				 opinsBySectionByJudgment
			 }
		unless (null opinsBySectionByJudgment) $ do
			let choicesJ = Collect.choicesByJudgment judgments
			forM_ (HM.toList opinsBySectionByJudgment) $ \(judgment@Judgment{..},opinsBySection) -> do
				H.div ! HA.class_ "judgment section-judgment document-judgment" $$ do
					html5ify judgment
					 { judgment_opinionsByChoice = listToMaybe opinsBySection
					 , judgment_choices = maybe [] snd $ HM.lookup judgment choicesJ
					 }
	where
	docHeaders =
		H.table ! HA.class_ "document-headers" $$
			H.tbody $$ do
				Loqualization l10n <- liftComposeState $ S.gets state_l10n
				forM_ series $ \s@Serie{id=id_, name} ->
					header $
						case urlSerie s of
						 Nothing -> do
							headerName  $ html5ify name
							headerValue $ html5ify id_
						 Just href -> do
							headerName  $ html5ify name
							headerValue $
								H.a ! HA.href (attrify href) $$
									html5ify id_
				forM_ links $ \Link{..} ->
					unless (TL.null $ unName name) $
						header $ do
							headerName  $ html5ify name
							headerValue $ html5ify $ Tree PlainEref{eref_href=href} plain
				forM_ date $ \d ->
					header $ do
						headerName  $ l10n_Header_Date l10n
						headerValue $ html5ify d
				forM_ url $ \href ->
					header $ do
						headerName  $ l10n_Header_Address l10n
						headerValue $ html5ify $ tree0 $ PlainEref{eref_href=href}
				forM_ headers $ \Header{..} ->
					header $ do
						headerName  $ html5ify name
						headerValue $ html5ify value
	docAuthors =
		H.table ! HA.class_ "document-authors" $$
			H.tbody $$ do
				forM_ authors $ \a ->
					H.tr $$
						H.td ! HA.class_ "author" $$
							html5ify a
	header :: HTML5 -> HTML5
	header hdr = H.tr ! HA.class_ "header" $$ hdr
	headerName :: HTML5 -> HTML5
	headerName hdr =
		H.td ! HA.class_ "header-name" $$ do
			hdr
			Loqualization l10n <- liftComposeState $ S.gets state_l10n
			Plain.l10n_Colon l10n
	headerValue :: HTML5 -> HTML5
	headerValue hdr =
		H.td ! HA.class_ "header-value" $$ do
			hdr

-- 'Html5ify' instances
instance Html5ify TCT.Location where
	html5ify = \case
	 s:|[] ->
		H.span ! HA.class_ "tct-location" $$
			html5ify $ show s
	 ss -> do
		H.ul ! HA.class_ "tct-location" $$
			forM_ ss $ \s ->
				H.li $$
					html5ify $ show s
instance Html5ify Body where
	html5ify body = do
		liftComposeState $ S.modify' $ \s -> s{state_section = body}
		mapM_ html5ify body
		case Seq.viewr body of
		 _ Seq.:> Tree BodyBlock{} _ -> do
			notes <- liftComposeState $ S.gets state_notes
			maybe mempty html5Notes $
				Map.lookup mempty notes
		 _ -> mempty
instance Html5ify (Tree BodyNode) where
	html5ify (Tree b bs) =
		case b of
		 BodyBlock blk -> html5ify blk
		 BodySection Section{..} -> do
			st@State{state_collect=Collect.All{..}} <- liftComposeState S.get
			liftComposeState $ S.modify' $ \s -> s{state_section = bs}
			do -- notes
				let mayNotes = do
					sectionPosPath <- XML.ancestors $ XML.pos_ancestors section_posXML
					let (sectionNotes, notes) = Map.updateLookupWithKey (\_ _ -> Nothing) sectionPosPath $ state_notes st
					(,notes) <$> sectionNotes
				case mayNotes of
				 Nothing -> mempty
				 Just (sectionNotes, state_notes) -> do
					liftComposeState $ S.modify' $ \s -> s{state_notes}
					html5Notes sectionNotes
			html5CommonAttrs section_attrs{classes="section":classes section_attrs, id=Nothing} $
				H.section ! HA.id (attrify $ identify section_posXML) $$ do
					forM_ section_aliases html5ify
					do -- judgments
						let sectionJudgments = state_judgments st `HS.union` HS.fromList section_judgments
						let opinsBySectionByJudgment = state_opinions st `HM.intersection` HS.toMap sectionJudgments
						let dropChildrenBlocksJudgments =
							-- NOTE: drop the "phantom" judgments concerning the 'BodyBlock's
							-- directly children of this 'BodySection'.
							if (`any`bs) $ \case
								 Tree BodyBlock{} _ -> True
								 _ -> False
							then List.tail
							else Cat.id
						liftComposeState $ S.modify' $ \s ->
							s{ state_judgments = sectionJudgments
							 , state_opinions  =
								-- NOTE: drop current opinions of the judgments of this section
								HM.unionWith (const $ List.tail . dropChildrenBlocksJudgments)
								 (state_opinions s)
								 opinsBySectionByJudgment
							 }
						unless (null opinsBySectionByJudgment) $ do
							liftComposeState $ S.modify' $ \s -> s
							 { state_styles = HS.insert (Left "dtc-judgment.css") $ state_styles s }
							H.aside ! HA.class_ "aside" $$ do
								let choicesJ = Collect.choicesByJudgment section_judgments
								forM_ (HM.toList opinsBySectionByJudgment) $ \(judgment@Judgment{..},opinsBySection) -> do
									H.div ! HA.class_ "judgment section-judgment" $$ do
										html5ify judgment
										 { judgment_opinionsByChoice = listToMaybe opinsBySection
										 , judgment_choices = maybe [] snd $ HM.lookup judgment choicesJ
										 }
					let mayId =
						case toList <$> HM.lookup section_title all_section of
						 Just [_] -> Just $ identifyTitle (Plain.state_l10n $ state_plainify st) section_title
						 _ -> Nothing
					H.table
					 ! HA.class_ "section-header"
					 !?? mayAttr HA.id mayId $$
						H.tbody $$
							H.tr $$ do
								H.td ! HA.class_ "section-number" $$ do
									html5SectionNumber $ XML.pos_ancestors section_posXML
								H.td ! HA.class_ "section-title" $$ do
									(case List.length $ XML.pos_ancestors section_posXML of
									 0 -> H.h1
									 1 -> H.h2
									 2 -> H.h3
									 3 -> H.h4
									 4 -> H.h5
									 5 -> H.h6
									 _ -> H.h6) $$
										html5ify section_title
					forM_ bs html5ify
					do -- judgments
						liftComposeState $ S.modify' $ \s ->
							s{ state_judgments = state_judgments st }
					do -- notes
						notes <- liftComposeState $ S.gets state_notes
						maybe mempty html5Notes $
							Map.lookup (XML.pos_ancestors section_posXML) notes
			liftComposeState $ S.modify' $ \s -> s{state_section = state_section st}
instance Html5ify Block where
	html5ify = \case
	 BlockPara para -> html5ify para
	 BlockBreak{..} ->
		html5CommonAttrs attrs
		 { classes = "page-break":"print-only":classes attrs } $
		H.div $$
			H.p $$ " " -- NOTE: force page break
	 BlockToC{..} ->
		H.nav ! HA.class_ "toc"
		      ! HA.id (attrify $ identify posXML) $$ do
			H.span ! HA.class_ "toc-name" $$
				H.a ! HA.href (refIdent $ identify posXML) $$ do
					Loqualization l10n <- liftComposeState $ S.gets state_l10n
					Plain.l10n_Table_of_Contents l10n
			H.ul $$ do
				State{state_section} <- liftComposeState S.get
				forM_ state_section $ html5ifyToC depth
	 BlockToF{..} -> do
		H.nav ! HA.class_ "tof"
		      ! HA.id (attrify $ identify posXML) $$
			H.table ! HA.class_ "tof" $$
				H.tbody $$
					html5ifyToF types
	 BlockAside{..} ->
		html5CommonAttrs attrs $
		H.aside ! HA.class_ "aside" $$ do
			forM_ blocks html5ify
	 BlockFigure{..} ->
		html5CommonAttrs attrs
		 { classes = "figure":("figure-"<>type_):classes attrs
		 , DTC.id  = Just $ identify $ XML.pos_ancestorsWithFigureNames posXML
		 } $
		H.div $$ do
			H.table ! HA.class_ "figure-caption" $$
				H.tbody $$
					H.tr $$ do
						if TL.null type_
						 then H.a ! HA.href (refIdent $ identify posXML) $$ mempty
						 else
							H.td ! HA.class_ "figure-number" $$ do
								H.a ! HA.href (refIdent $ identify $ XML.pos_ancestorsWithFigureNames posXML) $$ do
									html5ify type_
									html5ify $ XML.pos_ancestorsWithFigureNames posXML
						forM_ mayTitle $ \title -> do
							H.td ! HA.class_ "figure-colon" $$ do
								unless (TL.null type_) $ do
									Loqualization l10n <- liftComposeState $ S.gets state_l10n
									Plain.l10n_Colon l10n
							H.td ! HA.class_ "figure-title" $$ do
								html5ify title
			H.div ! HA.class_ "figure-content" $$ do
				html5ify paras
	 BlockIndex{posXML} -> do
		st@State{..} <- liftComposeState S.get
		liftComposeState $ S.put st
		 { state_styles = HS.insert (Left "dtc-index.css") state_styles }
		let (allTerms,refsByTerm) = state_indexs Map.!posXML
		let chars = Index.termsByChar allTerms
		H.div ! HA.class_ "index"
		      ! HA.id (attrify $ identify posXML) $$ do
			H.nav ! HA.class_ "index-nav" $$ do
				forM_ (Map.keys chars) $ \char ->
					H.a ! HA.href (refIdent (identify posXML <> "." <> identify char)) $$
						html5ify char
			H.dl ! HA.class_ "index-chars" $$
				forM_ (Map.toList chars) $ \(char,terms) -> do
					H.dt $$ do
						let i = identify posXML <> "." <> identify char
						H.a ! HA.id (attrify i)
						    ! HA.href (refIdent i) $$
							html5ify char
					H.dd $$
						H.dl ! HA.class_ "index-term" $$ do
						forM_ terms $ \aliases -> do
							H.dt $$
								H.ul ! HA.class_ "index-aliases" $$
									forM_ (List.take 1 aliases) $ \term -> do
										H.li ! HA.id (attrify $ identifyIref term) $$
											html5ify term
							H.dd $$
								let anchs =
									List.sortBy (compare `on` anchor_section . snd) $
									(`foldMap` aliases) $ \words ->
										fromJust $ do
											path <- Index.pathFromWords words
											Strict.maybe Nothing (Just . ((words,) <$>) . List.reverse) $
												TreeMap.lookup path refsByTerm in
								html5CommasDot $
								(<$> anchs) $ \(term,Anchor{..}) ->
									H.a ! HA.class_ "index-iref"
									    ! HA.href (refIdent $ identifyIrefCount term anchor_count) $$
										html5ify $ XML.pos_ancestors anchor_section
	 BlockReferences{..} ->
		html5CommonAttrs attrs
		 { classes = "references":classes attrs
		 , DTC.id  = Just $ Ident $ Plain.text def $ XML.pos_ancestors posXML
		 } $
		H.div $$ do
			H.table $$
				forM_ refs html5ify
	 BlockGrades{..} ->
		html5CommonAttrs attrs
		 { classes = "grades":classes attrs
		 , DTC.id  = Just $ Ident $ Plain.text def $ XML.pos_ancestors posXML
		 } $
		H.div $$ do
			-- let dg = List.head $ List.filter default_ scale
			-- let sc = MJ.Scale (Set.fromList scale) dg
			-- o  :: Map choice grade
			-- os :: Opinions (Map judge (Opinion choice grade))
			mempty
			-- html5ify $ show b
	 BlockJudges js -> html5ify js
instance Html5ify Para where
	html5ify = \case
	 ParaItem{..} ->
		html5CommonAttrs def
		 { classes="para":cls item
		 } $
			html5ify item
	 ParaItems{..} ->
		html5CommonAttrs attrs
		 { classes = "para":classes attrs
		 , DTC.id  = id_ posXML
		 } $
		H.div $$
			forM_ items $ \item ->
				html5AttrClass (cls item) $
				html5ify item
	 where
		id_ = Just . Ident . Plain.text def . XML.pos_ancestors
		cls = \case
		 ParaPlain{}      -> []
		 ParaArtwork{..}  -> ["artwork", "artwork-"<>type_]
		 ParaQuote{..}    -> ["quote", "quote-"<>type_]
		 ParaComment{}    -> []
		 ParaOL{}         -> ["ol"]
		 ParaUL{}         -> ["ul"]
		 ParaJudgment Judgment{..} -> ["judgment"] <> when (null judgment_opinionsByChoice) ["judgment-error"]
instance Html5ify ParaItem where
	html5ify = \case
	 ParaPlain p -> H.p $$ html5ify p
	 ParaArtwork{..} -> H.pre $$ do html5ify text
	 ParaQuote{..} -> H.div $$ do html5ify paras
	 ParaComment t -> html5ify $ H.Comment (H.String $ TL.unpack t) ()
	 ParaOL items ->
		H.table $$ do
			H.tbody $$
				forM_ items $ \ListItem{..} -> do
					H.tr $$ do
						H.td ! HA.class_ "name" $$ do
							html5ify name
							"."::HTML5
						H.td ! HA.class_ "value" $$
							html5ify paras
	 ParaUL items ->
		H.dl $$ do
			forM_ items $ \item -> do
				H.dt $$ "—"
				H.dd $$ html5ify item
	 ParaJudgment j -> html5ify j
instance Html5ify [Para] where
	html5ify = mapM_ html5ify
instance Html5ify Plain where
	html5ify ps =
		case Seq.viewl ps of
		 Seq.EmptyL -> mempty
		 curr Seq.:< next ->
			case curr of
			-- NOTE: gather adjacent PlainNotes
			 Tree PlainNote{} _
			  | (notes, rest) <- Seq.spanl (\case {Tree PlainNote{} _ -> True; _ -> False}) next -> do
				H.sup ! HA.class_ "note-numbers" $$ do
					html5ify curr
					forM_ notes $ \note -> do
						", "::HTML5
						html5ify note
				" "::HTML5
				html5ify rest
			--
			 _ -> do
				html5ify curr
				html5ify next
instance Html5ify (Tree PlainNode)
 where html5ify (Tree n ls) =
	case n of
	 PlainBreak  -> html5ify H.br
	 PlainText t -> html5ify t
	 PlainGroup  -> html5ify ls
	 PlainB      -> H.strong $$ html5ify ls
	 PlainCode   -> H.code   $$ html5ify ls
	 PlainDel    -> H.del    $$ html5ify ls
	 PlainI -> do
		i <- liftComposeState $ do
			i <- S.gets $ Plain.state_italic . state_plainify
			S.modify $ \s ->
				s{state_plainify=
					(state_plainify s){Plain.state_italic=
						not i}}
			return i
		H.em ! HA.class_ (if i then "even" else "odd") $$
			html5ify ls
		liftComposeState $
			S.modify $ \s ->
				s{state_plainify=
					(state_plainify s){Plain.state_italic=i}}
	 PlainSpan{..} ->
		html5CommonAttrs attrs $
		H.span $$ html5ify ls
	 PlainSub  -> H.sub    $$ html5ify ls
	 PlainSup  -> H.sup    $$ html5ify ls
	 PlainSC   -> H.span ! HA.class_ "smallcaps" $$ html5ify ls
	 PlainU    -> H.span ! HA.class_ "underline" $$ html5ify ls
	 PlainNote{..} ->
		case note_number of
		 Nothing -> mempty
		 Just num ->
			H.a ! HA.class_ "note-ref"
			    ! HA.id ("note-ref."<>attrify num)
			    ! HA.href ("#note."<>attrify num) $$
				html5ify num
	 PlainQ -> do
		H.span ! HA.class_ "q" $$ do
			Loqualization l10n <- liftComposeState $ S.gets state_l10n
			Plain.l10n_Quote (html5ify $ Tree PlainI ls) l10n
	 PlainEref{..} ->
		H.a ! HA.class_ "eref"
		    ! HA.href (attrify eref_href) $$
			if null ls
			then html5ify $ unURL eref_href
			else html5ify ls
	 PlainIref{..} ->
		case iref_anchor of
		 Nothing -> html5ify ls
		 Just Anchor{..} ->
			H.span ! HA.class_ "iref"
			       ! HA.id (attrify $ identifyIrefCount iref_term anchor_count) $$
				html5ify ls
	 PlainTag{..} -> do
		st <- liftComposeState S.get
		let l10n = Plain.state_l10n $ state_plainify st
		case tag_error of
		 Nothing ->
			H.a ! HA.class_ "tag"
			    ! HA.href (refIdent $ identifyTitle l10n $ Title ls) $$
				html5ify ls
		 Just (ErrorTarget_Unknown num) ->
			H.span ! HA.class_ "tag tag-unknown"
			       ! HA.id (attrify $ identifyTag "-unknown" l10n ls (Just num)) $$
				html5ify ls
		 Just (ErrorTarget_Ambiguous num) ->
			H.span ! HA.class_ "tag tag-ambiguous"
			       ! HA.id (attrify $ identifyTag "-ambiguous" l10n ls num) $$
				html5ify ls
	 PlainRref{..} -> do
		case rref_error of
		 Nothing ->
			let ref = do
				"["::HTML5
				H.a ! HA.class_ "reference"
				    ! HA.href (refIdent $ identifyReference "" rref_to Nothing)
				    ! HA.id   (attrify  $ identifyReference "" rref_to rref_number) $$
					html5ify rref_to
				"]" in
			case toList ls of
			 [] -> ref
			 [Tree (PlainText "") _] -> do
				refs <- liftComposeState $ S.gets $ Collect.all_reference . state_collect
				case toList <$> HM.lookup rref_to refs of
				 Just [Reference{reference_about=About{..}}] -> do
					forM_ (List.take 1 titles) $ \(Title title) -> do
						html5ify $ Tree PlainQ $
							case url of
							 Nothing -> title
							 Just u -> pure $ Tree (PlainEref u) title
						" "::HTML5
						ref
				 _ -> mempty
			 _ -> do
				H.a ! HA.class_ "reference"
				    ! HA.href (refIdent $ identifyReference "" rref_to Nothing)
				    ! HA.id   (attrify  $ identifyReference "" rref_to rref_number) $$
					html5ify ls
				H.span ! HA.class_ "print-only" $$ do
					" "::HTML5
					ref
		 Just (ErrorTarget_Unknown num) -> do
			"["::HTML5
			H.span ! HA.class_ "reference reference-unknown"
			       ! HA.id (attrify $ identifyReference "-unknown" rref_to $ Just num) $$
				html5ify rref_to
			"]"
		 Just (ErrorTarget_Ambiguous num) -> do
			case toList ls of
			 [] -> mempty
			 [Tree (PlainText "") _] -> mempty
			 _ -> do
				html5ify ls
				" "::HTML5
			"["::HTML5
			H.span ! HA.class_ "reference reference-ambiguous"
			       !?? mayAttr HA.id (attrify . identifyReference "-ambiguous" rref_to . Just <$> num) $$
				html5ify rref_to
			"]"
instance Html5ify [Title] where
	html5ify =
		html5ify . fold . List.intersperse sep . toList
		where sep = Title $ Seq.singleton $ tree0 $ PlainText " — "
instance Html5ify Title where
	html5ify (Title t) = html5ify t
instance Html5ify About where
	html5ify About{..} = do
		html5Lines
		 [ html5CommasDot $ concat $
			 [ html5Titles titles
			 , html5ify <$> authors
			 , html5ify <$> maybeToList date
			 , html5ify <$> maybeToList editor
			 , html5ify <$> series
			 ]
		 , forM_ url $ \u ->
				H.span ! HA.class_ "print-only" $$ do
					"<"::HTML5
					html5ify u
					">"
		 ]
		where
		html5Titles :: [Title] -> [HTML5]
		html5Titles ts | null ts = []
		html5Titles ts = [html5Title $ joinTitles ts]
			where
			joinTitles = fold . List.intersperse sep . toList
			sep = Title $ Seq.singleton $ tree0 $ PlainText " — "
		html5Title (Title title) =
			html5ify $ Tree PlainQ $
				case url of
				 Nothing -> title
				 Just u -> pure $ Tree (PlainEref u) title
instance Html5ify Serie where
	html5ify s@Serie{id=id_, name} = do
		Loqualization l10n <- liftComposeState $ S.gets state_l10n
		case urlSerie s of
		 Nothing -> do
			html5ify name
			Plain.l10n_Colon l10n :: HTML5
			html5ify id_
		 Just href -> do
			html5ify $
				Tree PlainEref{eref_href=href} $
				Seq.fromList
				 [ tree0 $ PlainText $ unName name
				 , tree0 $ PlainText $ Plain.l10n_Colon l10n
				 , tree0 $ PlainText id_
				 ]
instance Html5ify Entity where
	html5ify Entity{..} = do
		case () of
		 _ | not (TL.null email) -> do
			H.span ! HA.class_ "no-print" $$
				html5ify $
					Tree (PlainEref $ URL $ "mailto:"<>email) $
						pure $ tree0 $ PlainText name
			H.span ! HA.class_ "print-only" $$
				html5ify $
					Tree PlainGroup $ Seq.fromList
					 [ tree0 $ PlainText name
					 , tree0 $ PlainText " <"
					 , Tree (PlainEref $ URL $ "mailto:"<>email) $
						pure $ tree0 $ PlainText email
					 , tree0 $ PlainText ">"
					 ]
		 _ | Just u <- url ->
			html5ify $
				Tree (PlainEref u) $
					pure $ tree0 $ PlainText name
		 _ ->
			html5ify $
				tree0 $ PlainText name
		forM_ org $ \o -> do
			" ("::HTML5
			html5ify o
			")"::HTML5
instance Html5ify Words where
	html5ify = html5ify . Index.plainifyWords
instance Html5ify Alias where
	html5ify Alias{..} = do
		st@State{state_collect=Collect.All{..}} <- liftComposeState S.get
		let l10n = Plain.state_l10n $ state_plainify st
		case toList <$> HM.lookup title all_section of
		 Just [_] ->
			H.a ! HA.class_ "alias"
			    ! HA.id (attrify $ identifyTitle l10n title) $$
				mempty
		 _ -> mempty
instance Html5ify URL where
	html5ify (URL url) =
		H.a ! HA.class_ "eref"
		    ! HA.href (attrify url) $$
			html5ify url
instance Html5ify Date where
	html5ify date = do
		Loqualization l10n <- liftComposeState $ S.gets state_l10n
		Plain.l10n_Date date l10n
instance Html5ify Reference where
	html5ify Reference{..} =
		H.tr $$ do
			H.td ! HA.class_ "reference-key" $$
				html5ify $ tree0 PlainRref
				 { rref_number = Nothing
				 , rref_locTCT = def
				 , rref_to     = reference_id
				 , rref_error  = (<$> reference_error) $ \case
					 ErrorAnchor_Ambiguous num -> ErrorTarget_Ambiguous (Just num)
				 }
			H.td ! HA.class_ "reference-content" $$ do
				html5ify reference_about
				rrefs <- liftComposeState $ S.gets state_rrefs
				case HM.lookup reference_id rrefs of
				 Nothing -> pure ()
				 Just anchs ->
					H.span ! HA.class_ "reference-rrefs" $$
						html5CommasDot $
						(<$> List.reverse anchs) $ \(maySection,num) ->
							H.a ! HA.class_ "reference-rref"
							    ! HA.href (refIdent $ identifyReference "" reference_id $ Just num) $$
								case maySection of
								 Nothing -> "0"::HTML5
								 Just Section{section_posXML=posSection} -> html5ify $ XML.pos_ancestors posSection
instance Html5ify XML.Ancestors where
	html5ify ancs =
		case toList ancs of
		 [(_n,c)] -> do
			html5ify $ show c
			html5ify '.'
		 as ->
			html5ify $
				Text.intercalate "." $
				Text.pack . show . snd <$> as
instance Html5ify Plain.Plain where
	html5ify p = do
		sp <- liftComposeState $ S.gets state_plainify
		let (t,sp') = Plain.runPlain p sp
		html5ify t
		liftComposeState $ S.modify $ \s -> s{state_plainify=sp'}
{-
instance Html5ify SVG.Element where
	html5ify svg =
		html5ify $
		B.preEscapedLazyText $
		SVG.renderText svg
instance Semigroup SVG.Element where
	(<>) = mappend
-}

html5CommasDot :: [HTML5] -> HTML5
html5CommasDot [] = pure ()
html5CommasDot hs = do
	sequence_ $ List.intersperse ", " hs
	"."

html5Lines :: [HTML5] -> HTML5
html5Lines hs = sequence_ $ List.intersperse (html5ify H.br) hs

html5Words :: [HTML5] -> HTML5
html5Words hs = sequence_ $ List.intersperse " " hs

html5SectionNumber :: XML.Ancestors -> HTML5
html5SectionNumber = go mempty
	where
	go :: XML.Ancestors -> XML.Ancestors -> HTML5
	go prev next =
		case Seq.viewl next of
		 Seq.EmptyL -> pure ()
		 a@(_n,rank) Seq.:< as -> do
			H.a ! HA.href (refIdent $ identify $ prev Seq.|> a) $$
				html5ify $ show rank
			when (not (null as) || null prev) $ do
				html5ify '.'
				go (prev Seq.|>a) as

html5SectionRef :: XML.Ancestors -> HTML5
html5SectionRef as =
	H.a ! HA.href (refIdent $ identify as) $$
		html5ify as

html5Notes :: IntMap [Para] -> HTML5
html5Notes notes =
	H.aside ! HA.class_ "notes" $$ do
		Compose $ pure H.hr
		H.table $$
			H.tbody $$
				forM_ (IntMap.toList notes) $ \(number,content) ->
					H.tr $$ do
						H.td ! HA.class_ "note-ref" $$ do
							H.a ! HA.class_ "note-number"
							    ! HA.id   ("note."<>attrify number)
							    ! HA.href ("#note."<>attrify number) $$ do
								html5ify number
							". "::HTML5
							H.a ! HA.href ("#note-ref."<>attrify number) $$ do
								"↑"
						H.td $$
							html5ify content

html5ifyToC :: Maybe DTC.Nat -> Tree BodyNode -> HTML5
html5ifyToC depth (Tree b bs) =
	case b of
	 BodySection Section{..} -> do
		H.li $$ do
			H.table ! HA.class_ "toc-entry" $$
				H.tbody $$
					H.tr $$ do
						H.td ! HA.class_ "section-number" $$
							html5SectionRef $ XML.pos_ancestors section_posXML
						H.td ! HA.class_ "section-title" $$
							html5ify $ cleanPlain $ unTitle section_title
			when (maybe True (> Nat 1) depth && not (null sections)) $
				H.ul $$
					forM_ sections $
						html5ifyToC (depth >>= predNat)
	 _ -> mempty
	where
	sections =
		(`Seq.filter` bs) $ \case
		 Tree BodySection{} _ -> True
		 _ -> False

html5ifyToF :: [TL.Text] -> HTML5
html5ifyToF types = do
	figuresByType <- liftComposeState $ S.gets $ Collect.all_figure . state_collect
	let figures =
		Map.foldMapWithKey (\ty -> ((ty,) <$>)) $
		if null types
		then figuresByType
		else
			Map.intersection figuresByType $
			Map.fromList [(ty,()) | ty <- types]
	forM_ (Map.toList figures) $ \(posXML, (type_, title)) ->
		H.tr $$ do
			H.td ! HA.class_ "figure-number" $$
				H.a ! HA.href (refIdent $ identify posXML) $$ do
					html5ify type_
					html5ify $ XML.pos_ancestors posXML
			forM_ title $ \ti ->
				H.td ! HA.class_ "figure-title" $$
					html5ify $ cleanPlain $ unTitle ti

-- 'Attrify'
instance Attrify Plain.Plain where
	attrify p = attrify t
		where (t,_) = Plain.runPlain p def