{-# 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.Eq (Eq(..))
import Data.Foldable (Foldable(..), concat, fold)
import Data.Function (($), (.), const,  on)
import Data.Functor ((<$>), (<$))
import Data.Functor.Compose (Compose(..))
import Data.List.NonEmpty (NonEmpty(..))
import Data.Locale hiding (Index)
import Data.Maybe (Maybe(..), maybe, mapMaybe, isNothing, fromMaybe)
import Data.Monoid (Monoid(..))
import Data.Ord (Ord(..))
import Prelude (succ)
import Data.Sequence (Seq)
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.Monad.Trans.RWS.Strict as RWS
import qualified Control.Monad.Trans.Reader as R
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as HS
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 TM
import qualified Safe
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes  as HA
import qualified Text.Blaze.Internal as H

import Control.Monad.Utils
import Hdoc.DTC.Document as DTC
import Hdoc.DTC.Write.HTML5.Base
import Hdoc.DTC.Write.HTML5.Error ()
import Hdoc.DTC.Write.HTML5.Ident
import Hdoc.DTC.Write.HTML5.Judgment
import Hdoc.DTC.Write.Plain (Plainify(..))
import Hdoc.DTC.Write.XML ()
import Hdoc.Utils
import Text.Blaze.Utils
import Text.Blaze.XML ()
import qualified Hdoc.DTC.Analyze.Check as Analyze
import qualified Hdoc.DTC.Analyze.Collect as Analyze
import qualified Hdoc.DTC.Analyze.Index as Analyze
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 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_init = do
	let all_index = Analyze.collectIndex doc_init
	let (doc@DTC.Document{..}, all_irefs) =
		Analyze.indexifyDocument (fold all_index) doc_init
	let all = Analyze.collect doc `R.runReader` def
	let err = Analyze.errors all
	let ro = def
		 { reader_l10n     = loqualize config_locale
		 , reader_plainify = def{Plain.reader_l10n = loqualize config_locale}
		 , reader_all      = all
		 -- , reader_body  = body
		 }
	let st = def
		 { state_errors  = debug "errors" $ Nat1 1 <$ err
		 , state_notes   = fold $ toList <$> Analyze.all_notes all
		 , state_indices =
			(<$> toList all_index) $ \terms ->
				(terms,) $
				TM.intersection const all_irefs $
				Analyze.indexOfTerms terms
		 }
	let (html5Body, _endState, endWriter) =
		runComposeRWS ro st $ do
			analyseJudgments doc
			html5ify err
			html5ify doc
	html5Head <- writeHTML5Head conf ro endWriter doc
	return $ do
		H.docType
		H.html ! HA.lang (attrify $ countryCode config_locale) $ do
			html5Head
			H.body $ do
				{- NOTE:
				unless (null state_scripts) $ do
					-- NOTE: indicate that JavaScript is active.
					H.script ! HA.type_ "application/javascript" $
						"document.body.className = \"script\";"
				-}
				html5Body

writeHTML5Head :: Config -> Reader -> Writer -> Document -> IO Html
writeHTML5Head Config{..} Reader{..} Writer{..} Document{..} = do
	csss :: Html <- do
		-- unless (any (\DTC.Link{..} -> link_rel == "stylesheet" && link_url /= URL "") links) $ do
		(`foldMap` writer_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 $ do
			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
	scripts :: Html <-
		(`foldMap` writer_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{link_rel} -> link_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 (TL.null config_generator) $ do
				H.meta ! HA.name "generator"
				       ! HA.content (attrify config_generator)
			case document_head of
			 Nothing -> mempty
			 Just Head{head_section=Section{section_about=About{..}}, ..} -> do
				case about_titles of
				 title:_ -> H.title $ H.toMarkup $ Plain.text reader_plainify title
				 _ -> mempty
				forM_ about_links $ \Link{..} ->
					case link_rel of
					 "stylesheet" | URL "" <- link_url ->
						H.style ! HA.type_ "text/css" $
							H.toMarkup $ Plain.text def link_plain
					 _ ->
						H.link ! HA.rel  (attrify link_rel)
						       ! HA.href (attrify link_url)
				unless (null about_tags) $
					H.meta ! HA.name "keywords"
					       ! HA.content (attrify $ TL.intercalate ", " about_tags)
				let chapters =
					(`mapMaybe` toList document_body) $ \case
					 Tree (BodySection s) _ -> Just s
					 _ -> Nothing
				forM_ chapters $ \Section{..} ->
					H.link ! HA.rel "Chapter"
					       ! HA.title (attrify $ plainify $ Safe.headDef def about_titles)
					       ! HA.href (refIdent $ identify section_posXML)
			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
			csss
			scripts

instance Html5ify Document where
	html5ify Document{document_head=Nothing, ..} =
		html5ify document_body
	html5ify Document{document_head=Just Head{..}, ..} = do
		localComposeRWS (\ro -> ro{reader_section = [head_section], reader_body = body}) $ do
			ro <- composeLift RWS.ask
			unless (null about_authors) $ do
				H.div ! HA.class_ "document-head" $$
					H.table $$ do
						H.tbody $$ do
							H.tr $$ do
								H.td ! HA.class_ "left"  $$ html5Headers
								H.td ! HA.class_ "right" $$ html5Roles
			unless (null about_titles) $ do
				H.div ! HA.class_ "title"
							! HA.id "document-title." $$ do
					forM_ about_titles $ \title ->
						H.h1 ! HA.id (attrify $ identifyTitle (Plain.reader_l10n $ reader_plainify ro) title) $$
							html5ify title
			html5SectionJudgments
			html5ify body
		where
		body = head_body <> document_body
		Section{section_about=About{..}, ..} = head_section
		html5Headers =
			H.table ! HA.class_ "document-headers" $$
				H.tbody $$ do
					Loqualization l10n <- composeLift $ RWS.asks reader_l10n
					forM_ about_series $ \s@Serie{..} ->
						header $
							case urlSerie s of
							 Nothing -> do
								headerName  $ html5ify serie_name
								headerValue $ html5ify serie_id
							 Just href -> do
								headerName  $ html5ify serie_name
								headerValue $
									H.a ! HA.href (attrify href) $$
										html5ify serie_id
					forM_ about_links $ \Link{..} ->
						unless (TL.null $ unName link_role) $
							header $ do
								headerName  $ html5ify link_role
								headerValue $ html5ify $ Tree PlainEref{eref_href=link_url} link_plain
					forM_ about_dates $ \d@Date{..} ->
						header $ do
							headerName $
								if TL.null $ unName date_role
								then l10n_Header_Date l10n
								else html5ify date_role
							headerValue $ html5ify d
					{-
					forM_ about_headers $ \Header{..} ->
						header $ do
							headerName  $ html5ify header_name
							headerValue $ html5ify header_value
					-}
		html5Roles =
			H.table ! HA.class_ "document-authors" $$
				H.tbody $$ do
					forM_ about_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 <- composeLift $ RWS.asks reader_l10n
				Plain.l10n_Colon l10n
		headerValue :: HTML5 -> HTML5
		headerValue hdr =
			H.td ! HA.class_ "header-value" $$ do
				hdr
instance Html5ify Body where
	html5ify body =
		localComposeRWS (\ro -> ro{reader_body = body}) $ go body
		where
		go bs =
			case Seq.viewl bs of
			 Seq.EmptyL ->
				popNotes >>= html5Notes
			 curr Seq.:< next -> do
				case curr of
				 Tree BodySection{} _ -> popNotes >>= html5Notes
				 _ -> mempty
				html5ify curr
				go next
instance Html5ify (Tree BodyNode) where
	html5ify (Tree b bs) = do
		case b of
		 BodyBlock blk -> html5ify blk
		 BodySection section@Section{section_about=About{..}, ..} -> do
			localComposeRWS (\ro -> ro
			 { reader_section = section : reader_section ro
			 , reader_body    = bs
			 }) $ do
				Reader{reader_all=Analyze.All{..}} <- composeLift RWS.ask
				notes <- popNotes
				html5CommonAttrs section_attrs
				 { attrs_classes = "section":attrs_classes section_attrs
				 , attrs_id      = Nothing
				 } $ do
					H.section ! HA.id (attrify $ identify section_posXML) $$ do
						forM_ about_aliases html5ify
						html5SectionJudgments
						let mayId =
							case attrs_id section_attrs of
							 Just ident | Just [_] <- toList <$> HM.lookup ident all_section ->
								Just $ identifyTag "" ident Nothing
							 _ -> Nothing
						H.table
						 ! HA.class_ "section-header"
						 !?? mayAttr HA.id mayId $$
							H.tbody $$
								case about_titles of
								 [] ->
									H.tr $$ do
										H.td ! HA.class_ "section-number" $$ do
											html5SectionAnchor section
								 title:titles -> do
									let hN = 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
									H.tr $$ do
										H.td ! HA.class_ "section-number" $$ do
											html5SectionAnchor section
										H.td ! HA.class_ "section-title" $$ do
											hN $$
												html5ify title
									forM_ titles $ \t ->
										H.tr $$ do
											H.td $$ mempty
											H.td ! HA.class_ "section-title" $$ do
												hN $$
													html5ify t
						html5ify bs
					html5Notes notes
						{- FIXME
						do -- notes
							notes <- composeLift $ S.gets state_notes
							maybe mempty html5Notes $
								Map.lookup (XML.pos_ancestors section_posXML) notes
						-}
instance Html5ify Block where
	html5ify = \case
	 BlockPara para -> html5ify para
	 BlockBreak{..} ->
		html5CommonAttrs attrs
		 { attrs_classes = "page-break":"print-only":attrs_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 <- composeLift $ RWS.asks reader_l10n
					Plain.l10n_Table_of_Contents l10n
			H.ul $$ do
				Reader{reader_body} <- composeLift RWS.ask
				forM_ reader_body $ 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
		 { attrs_classes = "figure":("figure-"<>type_):attrs_classes attrs
		 , attrs_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 <- composeLift $ RWS.asks reader_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
		State{..} <- composeLift RWS.get
		composeLift $ do
			RWS.tell def
			 { writer_styles = HS.singleton $ Left "dtc-index.css" }
			RWS.modify $ \s -> s{state_indices=List.tail state_indices}
		let (allTerms,refsByTerm) = List.head state_indices
		let chars = Analyze.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 Nothing) $$
											html5ify term
							H.dd $$ do
								let sortedRefs =
									List.sortBy (compare `on` snd) $
									(`foldMap` aliases) $ \term ->
										fromMaybe def $ do
											path <- DTC.pathFromWords term
											refs <- Strict.maybe Nothing Just $ TM.lookup path refsByTerm
											return $
												Seq.foldrWithIndex (\num ref acc -> ((term, succ num), ref):acc) [] $
												Seq.reverse refs
								html5CommasDot $
									(<$> sortedRefs) $ \((term, num), section) ->
										H.a ! HA.class_ "index-iref"
										    ! HA.href (refIdent $ identifyIref term $ Just $ Nat1 num) $$
											html5ify $ XML.pos_ancestors $ section_posXML section
	 BlockReferences{..} ->
		html5CommonAttrs attrs
		 { attrs_classes = "references":attrs_classes attrs
		 , attrs_id      = Just $ identify $ XML.pos_ancestors posXML
		 } $
		H.div $$ do
			H.table $$
				forM_ refs html5ify
	 BlockGrades{..} ->
		html5CommonAttrs attrs
		 { attrs_classes = "grades":attrs_classes attrs
		 , attrs_id      = Just $ identify $ 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
		 { attrs_classes = "para":cls item
		 } $
			html5ify item
	 ParaItems{..} ->
		html5CommonAttrs attrs
		 { attrs_classes = "para":attrs_classes attrs
		 , attrs_id      = id_ posXML
		 } $
		H.div $$
			forM_ items $ \item ->
				html5AttrClass (cls item) $
				html5ify item
	 where
		id_ = Just . identify . 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.dl $$ do
			forM_ items $ \ListItem{..} -> do
				H.dt ! HA.class_ "name" $$ do
					html5ify name
					"."::HTML5
				H.dd ! 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 ps) =
	case n of
	 PlainBreak  -> html5ify H.br
	 PlainText t -> html5ify t
	 PlainGroup  -> html5ify ps
	 PlainB      -> H.strong $$ html5ify ps
	 PlainCode   -> H.code   $$ html5ify ps
	 PlainDel    -> H.del    $$ html5ify ps
	 PlainI -> do
		i <- composeLift $ RWS.asks reader_italic
		H.em ! HA.class_ (if i then "even" else "odd") $$
			localComposeRWS (\ro -> ro{reader_italic=not i}) $
				html5ify ps
	 PlainSpan{..} ->
		html5CommonAttrs attrs $
		H.span $$ html5ify ps
	 PlainSub  -> H.sub    $$ html5ify ps
	 PlainSup  -> H.sup    $$ html5ify ps
	 PlainSC   -> H.span ! HA.class_ "smallcaps" $$ html5ify ps
	 PlainU    -> H.span ! HA.class_ "underline" $$ html5ify ps
	 PlainNote{..} -> do
		num <- composeLift $ do
			num <- RWS.gets state_note_num_ref
			RWS.modify $ \s -> s{state_note_num_ref=succNat1 num}
			return 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 <- composeLift $ RWS.asks reader_l10n
			Plain.l10n_Quote (html5ify $ Tree PlainI ps) l10n
	-- <eref>
	 PlainEref{..} -> do
		H.a ! HA.class_ "eref no-print"
		    ! HA.href (attrify eref_href) $$
			if null ps
			then html5ify $ unURL eref_href
			else html5ify ps
		H.span ! HA.class_ "eref print-only" $$ do
			unless (null ps) $ do
				html5ify ps
				" "::HTML5
			"<"::HTML5
			html5ify eref_href
			">"
	-- <tag>
	 PlainTag{..}
	  -- backward
	  | tag_back -> do
		Reader{reader_all=Analyze.All{..}} <- composeLift RWS.ask
		State{state_errors=Analyze.Errors{..}} <- composeLift RWS.get
		case HM.lookup tag_ident all_tag of
		 Nothing -> pure ()
		 Just anchs ->
			H.span ! HA.class_ "tag-backs" $$
				html5Commas $
				(<$> List.zip (toList anchs) [1..]) $ \((_loc, maySection),idNum) ->
					H.a ! HA.class_ "tag-back"
					    ! HA.href (refIdent $ identifyTag "-back" tag_ident $ Just $ Nat1 idNum) $$
						html5SectionNumber maySection
	  -- forward
	  | otherwise -> do
		State{state_tag} <- composeLift RWS.get
		let idNum = HM.lookupDefault (Nat1 1) tag_ident state_tag
		composeLift $ RWS.modify $ \s -> s
		 { state_tag = HM.insert tag_ident (succNat1 idNum) state_tag }
		H.span ! HA.class_ "tag"
		       ! HA.id (attrify $ identifyTag "-back" tag_ident $ Just idNum) $$
			html5ify tag_ident
	-- <at>
	 PlainAt{..}
	  -- backward
	  | at_back -> do
		Reader{reader_all=Analyze.All{..}} <- composeLift RWS.ask
		State{state_errors=Analyze.Errors{..}} <- composeLift RWS.get
		case HM.lookup at_ident all_at of
		 Nothing -> pure ()
		 Just anchs ->
			H.span ! HA.class_ "at-backs" $$
				html5Commas $
				(<$> List.zip (toList anchs) [1..]) $ \((_loc, maySection),idNum) ->
					H.a ! HA.class_ "at-back"
					    ! HA.href (refIdent $ identifyAt "-back" at_ident $ Just $ Nat1 idNum) $$
						html5SectionNumber maySection
	  -- forward
	  | otherwise -> do
		Reader{..} <- composeLift RWS.ask
		State{state_errors=errs@Analyze.Errors{..}, ..} <- composeLift RWS.get
		let idNum = HM.lookupDefault (Nat1 1) at_ident state_at
		composeLift $ RWS.modify $ \s -> s
		 { state_at = HM.insert at_ident (succNat1 idNum) state_at }
		case () of
		-- unknown
		 _ | Just errNum <- HM.lookup at_ident errors_at_unknown -> do
			composeLift $ RWS.modify $ \s -> s
			 { state_errors = errs
				 { Analyze.errors_at_unknown =
					HM.adjust succNat1 at_ident errors_at_unknown } }
			H.span
			 ! HA.class_ "at at-unknown"
			 ! HA.id (attrify $ identifyAt "-unknown" at_ident (Just errNum)) $$
				H.span
				 ! HA.class_ "at at-unknown"
				 ! HA.id (attrify $ identifyAt "-back" at_ident $ Just idNum) $$
					html5ify at_ident
		-- ambiguous
		   | Just errNum <- HM.lookup at_ident errors_at_ambiguous -> do
			composeLift $ RWS.modify $ \s -> s
			 { state_errors = errs
				 { Analyze.errors_at_ambiguous =
					HM.adjust succNat1 at_ident errors_at_ambiguous } }
			H.span
			 ! HA.class_ "at at-ambiguous"
			 ! HA.id (attrify $ identifyAt "-ambiguous" at_ident (Just errNum)) $$
				H.span
				 ! HA.class_ "at at-ambiguous"
				 ! HA.id (attrify $ identifyAt "-back" at_ident $ Just idNum) $$
					html5ify at_ident
		-- known
		   | otherwise -> do
			H.a
			 ! HA.class_ "at"
			 ! HA.href (refIdent $ identifyAt "" at_ident Nothing)
			 ! HA.id (attrify $ identifyAt "-back" at_ident $ Just idNum) $$
				html5ify at_ident
	-- <ref>
	 PlainRef{..} -> do
		Reader{reader_all=Analyze.All{..}} <- composeLift RWS.ask
		State{state_errors=errs@Analyze.Errors{..}, ..} <- composeLift RWS.get
		let idNum = HM.lookupDefault (Nat1 1) ref_ident state_ref
		composeLift $ RWS.modify $ \s -> s
		 { state_ref = HM.insert ref_ident (succNat1 idNum) state_ref }
		case toList $ HM.lookupDefault def ref_ident all_reference of
		-- unknown
		 [] -> do
			let errNum = HM.lookup ref_ident errors_ref_unknown
			composeLift $ RWS.modify $ \s -> s
			 { state_errors = errs
				 { Analyze.errors_ref_unknown =
					HM.adjust succNat1 ref_ident errors_ref_unknown } }
			H.span
			 ! HA.class_ "reference reference-unknown"
			 ! HA.id (attrify $ identifyReference "-unknown" ref_ident errNum) $$ do
				"["::HTML5
				html5ify ref_ident
				"]"
		-- known
		 [Reference{..}] -> do
			let a = H.a ! HA.href (refIdent $ identifyReference "" ref_ident Nothing)
			let ref = do
				H.span
				 ! HA.class_ "reference"
				 ! HA.id (attrify  $ identifyReference "" ref_ident $ Just idNum) $$ do
					"["::HTML5
					a $$ html5ify ref_ident
					"]"
			case toList ps of
			 [] -> ref
			 [Tree (PlainText "") _] -> do
				refs <- composeLift $ RWS.asks $ Analyze.all_reference . reader_all
				case toList <$> HM.lookup ref_ident refs of
				 Just [Reference{reference_about=About{..}}] -> do
					forM_ (List.take 1 about_titles) $ \(Title title) -> do
						html5ify $ Tree PlainQ $
							case List.filter ((\rel -> rel == "" || rel == "self") . link_rel) about_links of
							 [] -> title
							 Link{..}:_ -> pure $ Tree (PlainEref link_url) title
						" "::HTML5
						ref
				 _ -> mempty
			 _ -> do
				a $$ html5ify ps
				H.span ! HA.class_ "print-only" $$ do
					" "::HTML5
					ref
		-- ambiguous
		 _ -> do
			case toList ps of
			 [] -> mempty
			 [Tree (PlainText "") _] -> mempty
			 _ -> do
				html5ify ps
				" "::HTML5
			H.span ! HA.class_ "reference reference-ambiguous" $$ do
				"["::HTML5
				html5ify ref_ident
				"]"
	-- <iref>
	 PlainIref{..} ->
		case pathFromWords iref_term of
		 Nothing -> html5ify ps
		 Just path -> do
			Reader{reader_all=Analyze.All{..}} <- composeLift RWS.ask
			State{state_irefs} <- composeLift RWS.get
			let num = Strict.fromMaybe (Nat1 1) $ TM.lookup path state_irefs
			composeLift $ RWS.modify $ \s -> s
			 { state_irefs = TM.insert const path (succNat1 num) state_irefs }
			H.span ! HA.class_ "iref"
			       ! HA.id (attrify $ identifyIref iref_term $ Just num) $$
				html5ify ps
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
		Loqualization l10n <- composeLift $ RWS.asks reader_l10n
		H.p $$
			html5CommasDot $ concat
			 [ html5Titles about_titles
			 , html5ify <$> about_authors
			 , html5ify <$> about_dates
			 , html5ify <$> about_series
			 ]
		forM_ about_links $ \Link{..} ->
			case () of
			 _ | link_rel == ""
			  || link_rel == "self" ->
				H.p ! HA.class_ "reference-url print-only" $$ do
					html5ify $ Tree PlainEref{eref_href=link_url} link_plain
			 _ ->
				H.p ! HA.class_ "reference-url" $$ do
					html5ify link_role
					Plain.l10n_Colon l10n :: HTML5
					html5ify $ Tree PlainEref{eref_href=link_url} link_plain
		forM_ about_description $ \description -> do
			H.div ! HA.class_ "reference-description" $$ do
				html5ify description
		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) = do
			H.span ! HA.class_ "no-print" $$
				html5ify $ Tree PlainQ $
					case List.filter ((\rel -> rel == "" || rel == "self") . link_rel) about_links of
					 [] -> title
					 Link{..}:_ -> pure $ Tree (PlainEref link_url) title
			H.span ! HA.class_ "print-only" $$
				html5ify $ Tree PlainQ title
instance Html5ify Serie where
	html5ify s@Serie{..} = do
		Loqualization l10n <- composeLift $ RWS.asks reader_l10n
		case urlSerie s of
		 Nothing -> do
			html5ify serie_name
			Plain.l10n_Colon l10n :: HTML5
			html5ify serie_id
		 Just href -> do
			html5ify $
				Tree PlainEref{eref_href=href} $
				Seq.fromList
				 [ tree0 $ PlainText $ unName serie_name
				 , tree0 $ PlainText $ Plain.l10n_Colon l10n
				 , tree0 $ PlainText serie_id
				 ]
instance Html5ify Entity where
	html5ify Entity{..} = do
		case () of
		 _ | not (TL.null entity_email) -> do
			H.span ! HA.class_ "no-print" $$ do
				html5ify $
					Tree (PlainEref $ URL $ "mailto:"<>entity_email) $
						pure $ tree0 $ PlainText entity_name
				html5ify $ orgs entity_org
			H.span ! HA.class_ "print-only" $$
				html5ify $
					Tree (PlainEref $ URL entity_email) $
						pure $ tree0 $ PlainText $
							entity_name <> orgs entity_org
			where
			orgs = foldMap $ \Entity{entity_name=name, entity_org=org} -> " ("<>name<>orgs org<>")"
		 _ | Just u <- entity_url ->
			html5ify $
				Tree (PlainEref u) $
					pure $ tree0 $ PlainText entity_name
		 _ ->
			html5ify $
				tree0 $ PlainText entity_name
instance Html5ify Words where
	html5ify = html5ify . Analyze.plainifyWords
instance Html5ify Alias where
	html5ify Alias{..} = do
		Reader{reader_all=Analyze.All{..}} <- composeLift RWS.ask
		let mayId =
			case attrs_id alias_attrs of
			 Just ident | Just [_] <- toList <$> HM.lookup ident all_section ->
				Just $ identifyTag "" ident Nothing
			 _ -> Nothing
		H.a ! HA.class_ "alias"
		    !?? mayAttr HA.id mayId $$
			mempty
instance Html5ify URL where
	html5ify (URL url) =
		H.a ! HA.class_ "url"
		    ! HA.href (attrify url) $$
			html5ify url
instance Html5ify Date where
	html5ify date@Date{..} = do
		Loqualization l10n <- composeLift $ RWS.asks reader_l10n
		case (date_rel, date_role) of
		 ("", "") -> ""::HTML5
		 (_, "") -> do
			html5ify date_rel
			Plain.l10n_Colon l10n
		 _ -> do
			html5ify date_role
			Plain.l10n_Colon l10n
		Plain.l10n_Date date l10n
instance Html5ify Reference where
	html5ify Reference{..} = do
		Reader{reader_all=Analyze.All{..}} <- composeLift RWS.ask
		State{state_errors=errs@Analyze.Errors{..}, ..} <- composeLift RWS.get
		H.tr $$ do
			H.td ! HA.class_ "reference-key" $$ do
				"["::HTML5
				case HM.lookup reference_id errors_reference_ambiguous of
				 Nothing ->
					H.a ! HA.class_ "reference"
					    ! HA.href (refIdent $ identifyReference "" reference_id Nothing)
					    ! HA.id   (attrify  $ identifyReference "" reference_id Nothing) $$
						html5ify reference_id
				 Just errNum -> do
					composeLift $ RWS.modify $ \s -> s
					 { state_errors = errs
						 { Analyze.errors_reference_ambiguous =
							HM.insert reference_id (succNat1 errNum) errors_reference_ambiguous } }
					H.span ! HA.class_ "reference reference-ambiguous"
					       ! HA.id (attrify $ identifyReference "-ambiguous" reference_id $ Just errNum) $$
						html5ify reference_id
				"]"
			H.td ! HA.class_ "reference-content" $$ do
				html5ify reference_about
				case HM.lookup reference_id all_ref of
				 Nothing -> pure ()
				 Just anchs ->
					when (isNothing $ HM.lookup reference_id errors_reference_ambiguous) $ do
						H.p ! HA.class_ "ref-backs" $$
							html5CommasDot $
							(<$> List.zip (toList anchs) [1..]) $ \((_loc, maySection),num) ->
								H.a ! HA.class_ "ref-back"
								    ! HA.href (refIdent $ identifyReference "" reference_id $ Just $ Nat1 num) $$
									html5SectionNumber maySection
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
		rp <- composeLift $ RWS.asks reader_plainify
		html5ify $ Plain.runPlain p rp
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 SVG.Element where
	html5ify svg =
		html5ify $
		B.preEscapedLazyText $
		SVG.renderText svg
instance Semigroup SVG.Element where
	(<>) = mappend
-}

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

html5CommasDot :: [HTML5] -> HTML5
html5CommasDot [] = pure ()
html5CommasDot hs = do
	html5Commas hs
	"."

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

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

html5SectionAnchor :: Section -> HTML5
html5SectionAnchor = go mempty . XML.pos_ancestors . section_posXML
	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

html5SectionTo :: Section -> HTML5
html5SectionTo Section{..} =
	H.a ! HA.href (refIdent $ identify ancestors) $$
		html5ify ancestors
	where ancestors = XML.pos_ancestors section_posXML

html5SectionNumber :: Section -> HTML5
html5SectionNumber Section{..} =
	html5ify $ XML.pos_ancestors section_posXML

popNotes :: ComposeRWS Reader Writer State H.MarkupM (Seq [Para])
popNotes = do
	st <- composeLift RWS.get
	case {-debug "state_notes" $-} state_notes st of
	 [] -> return mempty
	 curr:next -> do
		composeLift $ RWS.modify $ \s -> s{state_notes=next}
		return curr

html5Notes :: Seq [Para] -> HTML5
html5Notes notes = do
	unless (null notes) $ do
		H.aside ! HA.class_ "notes" $$ do
			Compose $ pure H.hr
			H.table $$
				H.tbody $$
					forM_ notes $ \content -> do
						num <- composeLift $ do
							n <- RWS.gets state_note_num_content
							RWS.modify $ \s -> s{state_note_num_content=succNat1 n}
							return n
						H.tr $$ do
							H.td ! HA.class_ "note-ref" $$ do
								H.a ! HA.class_ "note-number"
								    ! HA.id   ("note."<>attrify num)
								    ! HA.href ("#note."<>attrify num) $$ do
									html5ify num
								". "::HTML5
								H.a ! HA.href ("#note-ref."<>attrify num) $$ do
									"↑"
							H.td $$
								html5ify content

html5ifyToC :: Maybe DTC.Nat -> Tree BodyNode -> HTML5
html5ifyToC depth (Tree b bs) =
	case b of
	 BodySection section@Section{section_about=About{..}, ..} -> do
		H.li $$ do
			H.table ! HA.class_ "toc-entry" $$
				H.tbody $$
					case about_titles of
					 [] ->
						H.tr $$ do
							H.td ! HA.class_ "section-number" $$
								html5SectionTo section
					 title:titles -> do
						H.tr $$ do
							H.td ! HA.class_ "section-number" $$
								html5SectionTo section
							H.td ! HA.class_ "section-title" $$
								html5ify $ cleanPlain $ unTitle title
						forM_ titles $ \t ->
							H.tr $$ do
								H.td ! HA.class_ "section-title" $$
									html5ify $ cleanPlain $ unTitle t
			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 <- composeLift $ RWS.asks $ Analyze.all_figure . reader_all
	let figures =
		Map.unions $
		((\(ty,ts) -> (ty,) <$> ts) <$>) $
		HM.toList $
		if null types
		then figuresByType
		else
			HM.intersection figuresByType $
			HM.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 $ Plain.runPlain p def