{-# 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(..), any, concat, fold)
import Data.Function (($), (.), const)
import Data.Functor ((<$>), (<$))
import Data.Functor.Compose (Compose(..))
import Data.List.NonEmpty (NonEmpty(..))
import Data.Locale hiding (Index)
import Data.Maybe (Maybe(..), maybe, mapMaybe, maybeToList, listToMaybe, isNothing)
import Data.Monoid (Monoid(..))
import Data.Ord (Ord(..))
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.Category as Cat
import qualified Control.Monad.Trans.Reader as R
import qualified Control.Monad.Trans.RWS.Strict as RWS
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.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 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 qualified Hdoc.DTC.Analyze.Check as Analyze
import qualified Hdoc.DTC.Analyze.Collect as Analyze
import qualified Hdoc.DTC.Analyze.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 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 all = R.runReader (Analyze.collect doc) 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_section  = body
		 }
	let st = def
		 { state_errors = debug "errors" $ Nat1 1 <$ err
		 , state_notes  = fold $ toList <$> {-debug "all_notes"-} (Analyze.all_notes all)
		 }
	let (html5Body, _endState, endWriter) =
		runComposeRWS ro st $ do
			html5Judgments
			html5ify err
			html5DocumentHead head
			html5ify body
	html5Head <- writeHTML5Head conf ro endWriter head body
	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
	{-
	let (checkedBody,checkState) =
		let state_collect = Analyze.collect doc in
		Analyze.check body `S.runState` def
		 { Analyze.state_irefs = foldMap Index.irefsOfTerms $ Analyze.all_index state_collect
		 , Analyze.state_collect
		 }
	let (html5Body, endState) =
		runComposeRWS def
		 { state_collect
		 {-
		 , state_indexs =
			(<$> Analyze.all_index state_collect) $ \terms ->
				(terms,) $
				TreeMap.intersection const state_irefs $
				Index.irefsOfTerms terms
		 , state_notes
		 -}
		 , state_rrefs
		 , state_section  = body
		 , state_l10n     = loqualize config_locale
		 , state_plainify = def{Plain.reader_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 -> Reader -> Writer -> Head -> Body -> IO Html
writeHTML5Head Config{..} Reader{..} Writer{..} Head{DTC.head_about=About{..}} body = do
	csss :: Html <- do
		-- unless (any (\DTC.Link{..} -> rel == "stylesheet" && href /= 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{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 about_titles) $ do
				H.title $
					H.toMarkup $ Plain.text reader_plainify $ List.head about_titles
			forM_ about_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_ about_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 about_tags) $
				H.meta ! HA.name "keywords"
				       ! HA.content (attrify $ TL.intercalate ", " about_tags)
			let chapters =
				(`mapMaybe` toList body) $ \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)
			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

html5DocumentHead :: Head -> HTML5
html5DocumentHead Head{DTC.head_about=About{..}, head_judgments} = 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"  $$ docHeaders
						H.td ! HA.class_ "right" $$ docAuthors
	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
	do -- judgments
		st <- composeLift RWS.get
		let sectionJudgments = debug "sectionJudgments" $ HS.fromList head_judgments
		let opinsBySectionByJudgment = debug "opinsBySectionByJudgment" $ state_opinions st `HM.intersection` HS.toMap sectionJudgments
		composeLift $ RWS.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 = Analyze.choicesByJudgment head_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 <- composeLift $ RWS.asks reader_l10n
				forM_ about_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_ about_links $ \Link{..} ->
					unless (TL.null $ unName name) $
						header $ do
							headerName  $ html5ify name
							headerValue $ html5ify $ Tree PlainEref{eref_href=href} plain
				forM_ about_date $ \d ->
					header $ do
						headerName  $ l10n_Header_Date l10n
						headerValue $ html5ify d
				forM_ about_url $ \href ->
					header $ do
						headerName  $ l10n_Header_Address l10n
						headerValue $ html5ify $ tree0 $ PlainEref{eref_href=href}
				forM_ about_headers $ \Header{..} ->
					header $ do
						headerName  $ html5ify header_name
						headerValue $ html5ify header_value
	docAuthors =
		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

-- '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 =
		localComposeRWS (\ro -> ro{reader_section = 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{..} -> do
			localComposeRWS (\ro -> ro{reader_section = bs}) $ do
				ro@Reader{reader_all=Analyze.All{..}} <- composeLift RWS.ask
				notes <- popNotes
				html5CommonAttrs section_attrs{classes="section":classes section_attrs, id=Nothing} $ do
					H.section ! HA.id (attrify $ identify section_posXML) $$ do
						forM_ section_aliases html5ify
						st <- composeLift RWS.get
						do -- judgments
							let sectionJudgments = debug "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
							composeLift $ RWS.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
								composeLift $ RWS.tell def
								 { writer_styles = HS.singleton $ Left "dtc-judgment.css" }
								H.aside ! HA.class_ "aside" $$ do
									let choicesJ = Analyze.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.reader_l10n $ reader_plainify ro) section_title
							 _ -> Nothing
						H.table
						 ! HA.class_ "section-header"
						 !?? mayAttr HA.id ({-debugOn "st" (const st)-} 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
						html5ify bs
						do -- judgments
							composeLift $ RWS.modify $ \s ->
								s{ state_judgments = state_judgments st }
					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
		 { 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 <- composeLift $ RWS.asks reader_l10n
					Plain.l10n_Table_of_Contents l10n
			H.ul $$ do
				Reader{reader_section} <- composeLift RWS.ask
				forM_ reader_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 <- 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
		st@State{..} <- composeLift RWS.get
		composeLift $ RWS.tell def
		 { writer_styles = HS.singleton $ Left "dtc-index.css" }
		{- FIXME
		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 <- DTC.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.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
	 PlainEref{..} ->
		H.a ! HA.class_ "eref"
		    ! HA.href (attrify eref_href) $$
			if null ps
			then html5ify $ unURL eref_href
			else html5ify ps
	 PlainIref{..} ->
		mempty
		{- FIXME
		case iref_anchor of
		 Nothing -> html5ify ps
		 Just Anchor{..} ->
			H.span ! HA.class_ "iref"
			       ! HA.id (attrify $ identifyIrefCount iref_term anchor_count) $$
				html5ify ps
		-}
	 PlainTag{..} -> do
		Reader{..} <- composeLift RWS.ask
		State{state_errors=errs@Analyze.Errors{..}} <- composeLift RWS.get
		let l10n = Plain.reader_l10n reader_plainify
		let tag = Title ps
		case () of
		 _ | Just num <- HM.lookup tag errors_tag_unknown -> do
			composeLift $ RWS.modify $ \s -> s
			 { state_errors = errs
				 { Analyze.errors_tag_unknown =
					HM.adjust succNat1 tag errors_tag_unknown } }
			H.span ! HA.class_ "tag tag-unknown"
			       ! HA.id (attrify $ identifyTag "-unknown" l10n tag (Just num)) $$
				html5ify tag
		   | Just num <- HM.lookup tag errors_tag_ambiguous -> do
			composeLift $ RWS.modify $ \s -> s
			 { state_errors = errs
				 { Analyze.errors_tag_ambiguous =
					HM.adjust succNat1 tag errors_tag_ambiguous } }
			H.span ! HA.class_ "tag tag-ambiguous"
			       ! HA.id (attrify $ identifyTag "-ambiguous" l10n tag (Just num)) $$
				html5ify tag
		   | otherwise -> do
			H.a ! HA.class_ "tag"
			    ! HA.href (refIdent $ identifyTitle l10n tag) $$
				html5ify tag
	 PlainRref{..} -> do
		Reader{reader_all=Analyze.All{..}} <- composeLift RWS.ask
		State{state_errors=errs@Analyze.Errors{..}, ..} <- composeLift RWS.get
		case toList $ HM.lookupDefault def rref_to all_reference of
		 [] -> do
			let num = HM.lookup rref_to errors_rref_unknown
			composeLift $ RWS.modify $ \s -> s
			 { state_errors = errs
				 { Analyze.errors_rref_unknown =
					HM.adjust succNat1 rref_to errors_rref_unknown } }
			"["::HTML5
			H.span ! HA.class_ "reference reference-unknown"
			       ! HA.id (attrify $ identifyReference "-unknown" rref_to num) $$
				html5ify rref_to
			"]"
		 [Reference{..}] -> do
			let num = HM.lookupDefault (Nat1 1) rref_to state_rrefs
			composeLift $ RWS.modify $ \s -> s
			 { state_rrefs = HM.insert rref_to (succNat1 num) state_rrefs }
			let a =
				H.a ! HA.class_ "reference"
				    ! HA.href (refIdent $ identifyReference "" rref_to Nothing)
				    ! HA.id   (attrify  $ identifyReference "" rref_to $ Just num)
			let ref = do
				"["::HTML5
				a $$ html5ify rref_to
				"]"
			case toList ps of
			 [] -> ref
			 [Tree (PlainText "") _] -> do
				refs <- composeLift $ RWS.asks $ Analyze.all_reference . reader_all
				case toList <$> HM.lookup rref_to refs of
				 Just [Reference{reference_about=About{..}}] -> do
					forM_ (List.take 1 about_titles) $ \(Title title) -> do
						html5ify $ Tree PlainQ $
							case about_url of
							 Nothing -> title
							 Just u -> pure $ Tree (PlainEref u) title
						" "::HTML5
						ref
				 _ -> mempty
			 _ -> do
				a $$ html5ify ps
				H.span ! HA.class_ "print-only" $$ do
					" "::HTML5
					ref
		 _ -> do
			case toList ps of
			 [] -> mempty
			 [Tree (PlainText "") _] -> mempty
			 _ -> do
				html5ify ps
				" "::HTML5
			"["::HTML5
			H.span ! HA.class_ "reference reference-ambiguous" $$
				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 about_titles
			 , html5ify <$> about_authors
			 , html5ify <$> maybeToList about_date
			 , html5ify <$> maybeToList about_editor
			 , html5ify <$> about_series
			 ]
		 , forM_ about_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 about_url of
				 Nothing -> title
				 Just u -> pure $ Tree (PlainEref u) title
instance Html5ify Serie where
	html5ify s@Serie{id=id_, name} = do
		Loqualization l10n <- composeLift $ RWS.asks reader_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
		ro@Reader{reader_all=Analyze.All{..}} <- composeLift RWS.ask
		let l10n = Plain.reader_l10n $ reader_plainify ro
		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 <- composeLift $ RWS.asks reader_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 num -> do
					composeLift $ RWS.modify $ \s -> s
					 { state_errors = errs
						 { Analyze.errors_reference_ambiguous =
							HM.insert reference_id (succNat1 num) errors_reference_ambiguous } }
					H.span ! HA.class_ "reference reference-ambiguous"
					       ! HA.id (attrify $ identifyReference "-ambiguous" reference_id $ Just num) $$
						html5ify reference_id
				"]"
			H.td ! HA.class_ "reference-content" $$ do
				html5ify reference_about
				case HM.lookup reference_id all_rrefs of
				 Nothing -> pure ()
				 Just anchs ->
					when (isNothing $ HM.lookup reference_id errors_reference_ambiguous) $
						H.span ! HA.class_ "reference-rrefs" $$
							html5CommasDot $
							(<$> List.zip (toList anchs) [1..]) $ \((_loc, maySection),num) ->
								H.a ! HA.class_ "reference-rref"
								    ! HA.href (refIdent $ identifyReference "" reference_id $ Just $ Nat1 num) $$
									case maySection of
									 Left{} -> "0"::HTML5
									 Right 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
		rp <- composeLift $ RWS.asks reader_plainify
		html5ify $ Plain.runPlain p rp
{-
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

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{..} -> 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 <- 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