{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hdoc.DTC.Write.HTML5 where

-- import Control.Arrow (first)
import Control.Applicative (Applicative(..))
import Control.Monad (Monad(..), join, (=<<), forM, forM_, mapM_, sequence_)
import Data.Bool
import Data.Char (Char)
import Data.Default.Class (Default(..))
import Data.Either (Either(..))
import Data.Eq (Eq(..))
import Data.Foldable (Foldable(..), concat, any)
import Data.Function (($), (.), const, on)
import Data.Functor ((<$>))
import Data.Functor.Compose (Compose(..))
import Data.Int (Int)
import Data.IntMap.Strict (IntMap)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Locale hiding (Index)
import Data.Map.Strict (Map)
import Data.Maybe (Maybe(..), maybe, mapMaybe, fromJust, maybeToList, listToMaybe, fromMaybe, isJust)
import Data.Monoid (Monoid(..))
import Data.Ord (Ord(..))
import Data.Semigroup (Semigroup(..))
import Data.String (String, IsString(..))
import Data.Text (Text)
import Data.TreeSeq.Strict (Tree(..), tree0)
import Data.Tuple (fst, snd)
import Prelude (mod, (*), Fractional(..), Double, toRational, RealFrac(..))
import System.FilePath (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.Char as Char
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.Set as Set
import qualified Data.Strict.Maybe as Strict
import qualified Data.Text as Text
import qualified Data.Text.Lazy as TL
import qualified Data.Tree as Tree
import qualified Data.TreeMap.Strict as TreeMap
import qualified Data.TreeSeq.Strict as TreeSeq
import qualified Hjugement as MJ
import qualified Prelude (error)
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes  as HA
import qualified Text.Blaze.Internal as H

import Text.Blaze.Utils

import Hdoc.TCT.Cell as TCT
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 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.Utils as FS
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

showJudgments :: HM.HashMap (Ident,Ident,Maybe Title) [Tree.Tree [Choice]] -> String
showJudgments js =
	Tree.drawForest $
	((show <$>) <$>) $
	-- Tree.Node (Left ("","",Nothing)) $
	(<$> HM.toList js) $ \((j,g,q),ts) ->
		Tree.Node
		 (Left (unIdent j,unIdent g,Plain.text def <$> q))
		 ((Right <$>) <$> ts)

-- * Type 'HTML5'
type HTML5 = StateMarkup State ()
instance IsString HTML5 where
	fromString = html5ify

-- ** Type 'Config'
data Config =
 forall locales.
 ( Locales   locales
 , Loqualize locales (L10n HTML5)
 , Loqualize locales (Plain.L10n Plain.Plain)
 ) =>
 Config
 { config_css       :: Either FilePath TL.Text
 , config_js        :: Either FilePath TL.Text
 , config_locale    :: LocaleIn locales
 , config_generator :: TL.Text
 }
instance Default Config where
	def = Config
	 { config_css       = Right "style/dtc-html5.css"
	 , config_js        = Right "style/dtc-html5.js"
	 , config_locale    = LocaleIn @'[EN] en_US
	 , config_generator = "https://hackage.haskell.org/package/hdoc"
	 }

-- ** Type 'State'
data State = State
 -- RW
 { state_styles    :: HS.HashSet (Either FilePath TL.Text)
 , state_scripts   :: HS.HashSet FilePath
 , state_notes     :: Check.NotesBySection
 , state_judgments :: HS.HashSet Judgment
 , state_opinions  :: HM.HashMap Judgment [MJ.OpinionsByChoice Choice Name (MJ.Ranked Grade)]
 -- RO
 , state_section   :: TreeSeq.Trees BodyNode
 , state_collect   :: Collect.All
 , state_indexs    :: Map XmlPos (Terms, Index.Irefs) -- TODO: could be a list
 , state_rrefs     :: HM.HashMap Ident [(Maybe Section,Nat1)]
 , state_plainify  :: Plain.State
 , state_l10n      :: Loqualization (L10n HTML5)
 }
instance Default State where
	def = State
	 { state_styles    = HS.fromList [Left "dtc-html5.css"]
	 , state_scripts   = def
	 , state_section   = def
	 , state_collect   = def
	 , state_indexs    = def
	 , state_rrefs     = def
	 , state_notes     = def
	 , state_plainify  = def
	 , state_l10n      = Loqualization EN_US
	 , state_judgments = HS.empty
	 , state_opinions  = def
	 }

writeHTML5 :: Config -> DTC.Document -> IO Html
writeHTML5 conf@Config{..} doc@DTC.Document{..} = do
	let collect@Collect.All{..} = Collect.collect doc
	let (checkedBody,checkState) =
		Check.check body `S.runState` def
		 { Check.state_irefs   = foldMap Index.irefsOfTerms all_index
		 , Check.state_collect = collect
		 }
	let (html5Body, endState) =
		let Check.State{..} = checkState in
		runStateMarkup def
		 { state_collect
		 , state_indexs =
			(<$> all_index) $ \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 title)
				       ! HA.href (refIdent $ identify xmlPos)
			csss
			scripts

html5DocumentHead :: Head -> HTML5
html5DocumentHead Head{DTC.about=About{..}, judgments} = do
	st <- liftStateMarkup 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
		liftStateMarkup $ 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{question},opinsBySection) -> do
				H.div ! HA.class_ "judgment section-judgment document-judgment" $$ do
					let choices = maybe [] snd $ HM.lookup judgment choicesJ
					let opins   = List.head opinsBySection
					html5Judgment question choices opins
	where
	docHeaders =
		H.table ! HA.class_ "document-headers" $$
			H.tbody $$ do
				Loqualization l10n <- liftStateMarkup $ 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{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{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 <- liftStateMarkup $ S.gets state_l10n
			Plain.l10n_Colon l10n
	headerValue :: HTML5 -> HTML5
	headerValue hdr =
		H.td ! HA.class_ "header-value" $$ do
			hdr

-- * Class 'Html5ify'
class Html5ify a where
	html5ify :: a -> HTML5
instance Html5ify H.Markup where
	html5ify = Compose . return
instance Html5ify Char where
	html5ify = html5ify . H.toMarkup
instance Html5ify Text where
	html5ify = html5ify . H.toMarkup
instance Html5ify TL.Text where
	html5ify = html5ify . H.toMarkup
instance Html5ify String where
	html5ify = html5ify . H.toMarkup
instance Html5ify Title where
	html5ify (Title t) = html5ify t
instance Html5ify Ident where
	html5ify (Ident i) = html5ify i
instance Html5ify Int where
	html5ify = html5ify . show
instance Html5ify Name where
	html5ify (Name i) = html5ify i
instance Html5ify Nat where
	html5ify (Nat n) = html5ify n
instance Html5ify Nat1 where
	html5ify (Nat1 n) = html5ify n
instance Html5ify a => Html5ify (Maybe a) where
	html5ify = foldMap html5ify
instance Html5ify TCT.Spans where
	html5ify = \case
	 s:|[] ->
		H.span ! HA.class_ "tct-position" $$
			html5ify $ show s
	 ss -> do
		H.ul ! HA.class_ "tct-position" $$
			forM_ ss $ \s ->
				H.li $$
					html5ify $ show s
instance Html5ify Check.Errors where
	html5ify Check.Errors{..} = do
		st@State
		 { state_collect = Collect.All{..}
		 , state_l10n    = Loqualization (l10n::FullLocale lang)
		 , ..
		 } <- liftStateMarkup S.get
		let errors :: [ ( Int{-errKind-}
		                , HTML5{-errKindDescr-}
		                , [(Plain{-errTypeKey-}, [(Spans{-errPos-}, Ident{-errId-})])]
		                ) ] =
			List.zipWith
			 (\errKind (errKindDescr, errByPosByKey) ->
				(errKind, errKindDescr l10n, errByPosByKey))
			 [1::Int ..]
			 [ (l10n_Error_Tag_unknown        , errorTag st "-unknown"      errors_tag_unknown)
			 , (l10n_Error_Tag_ambiguous      , errorTag st "-ambiguous"    errors_tag_ambiguous)
			 , (l10n_Error_Rref_unknown       , errorReference "-unknown"   errors_rref_unknown)
			 , (l10n_Error_Reference_ambiguous, errorReference "-ambiguous" errors_reference_ambiguous)
			 ]
		let numErrors = Nat $ sum $ (<$> errors) $ \(_typ, _descr, errByPosByKey) ->
			sum $ length . snd <$> errByPosByKey
		when (numErrors > Nat 0) $ do
			liftStateMarkup $ S.put st
			 { state_styles  =
				HS.insert (Left "dtc-errors.css") $
				HS.insert (Right $
					-- NOTE: Implement a CSS-powered show/hide logic, using :target
					"\n@media screen {" <>
					"\n\t.error-filter:target .errors-list > li {display:none;}" <>
					(`foldMap` errors) (\(num, _description, errs) ->
						if null errs then "" else
							let err = "error-type"<>TL.pack (show num)<>"\\." in
							"\n\t.error-filter#"<>err<>":target .errors-list > li."<>err
							 <>" {display:list-item}" <>
							"\n\t.error-filter#"<>err<>":target .errors-nav > ul > li."<>err
							 <>" {list-style-type:disc;}"
					 ) <>
					"\n}"
				 )
				state_styles
			 }
			filterIds errors $ H.div ! HA.class_ "document-errors" ! HA.id "document-errors." $$ do
				H.nav ! HA.class_ "errors-nav" $$ do
					H.p $$
						H.a ! HA.class_ "errors-all" ! HA.href (refIdent "document-errors.") $$ do
							l10n_Errors_All l10n numErrors :: HTML5
					H.ul $$
						forM_ errors $
						 \(errKind, errKindDescr, errs) -> do
							unless (null errs) $ do
								H.li ! HA.class_ (attrify $ errorType errKind) $$ do
									H.a ! HA.href (refIdent $ errorType errKind) $$ do
										errKindDescr
										" ("::HTML5
										html5ify $ sum $ length . snd <$> errs
										")"
				H.ol ! HA.class_ "errors-list" $$ do
					let errByPosByKey :: Map Spans{-errPos-} ( Int{-errKind-}
					                                         , HTML5{-errKindDescr-}
					                                         , Plain{-errKey-}
					                                         , [(Spans{-errPos-}, Ident{-errId-})] ) =
						(`foldMap`errors) $ \(errKind, errKindDescr, errByKey) ->
							(`foldMap`errByKey) $ \(errKey, errByPos) ->
								Map.singleton
								 (fst $ List.head errByPos)
								 -- NOTE: sort using the first position of this errKind with this errKey.
								 (errKind, errKindDescr, errKey, errByPos)
					forM_ errByPosByKey $
					 \(errKind, errKindDescr, errKey, errByPos) -> do
						H.li ! HA.class_ (attrify $ errorType errKind) $$ do
							H.span ! HA.class_ "error-message" $$ do
								H.span ! HA.class_ "error-kind" $$ do
									errKindDescr
									Plain.l10n_Colon l10n :: HTML5
								html5ify errKey
							H.ol ! HA.class_ "error-position" $$
								forM_ errByPos $ \(errPos, errId) ->
									H.li $$
										H.a ! HA.href (refIdent errId) $$
											html5ify errPos
		where
		errorType num = identify $ "error-type"<>show num<>"."
		-- | Nest error id= to enable showing/hidding errors using :target pseudo-class.
		filterIds [] h = h
		filterIds ((num, _description, errs):es) h =
			if null errs
			 then filterIds es h
			 else do
				H.div ! HA.class_ "error-filter"
				      ! HA.id (attrify $ errorType num) $$
					filterIds es h
		errorTag :: State -> Ident -> HM.HashMap Title (Seq.Seq TCT.Spans) -> [(Plain, [(TCT.Spans,Ident)])]
		errorTag State{state_plainify=Plain.State{state_l10n}} suffix errs =
			(<$> HM.toList errs) $ \(Title tag, errPositions) ->
				( tag
				, List.zipWith
				 (\num -> (,identifyTag suffix state_l10n tag (Just $ Nat1 num)))
				 [1::Int ..] (toList errPositions)
				)
		errorReference :: Ident -> HM.HashMap Ident (Seq.Seq TCT.Spans) -> [(Plain, [(TCT.Spans,Ident)])]
		errorReference suffix errs =
			(<$> HM.toList errs) $ \(id, errPositions) ->
				( pure $ tree0 $ PlainText $ unIdent id
				, List.zipWith
				 (\num -> (,identifyReference suffix id (Just $ Nat1 num)))
				 [1::Int ..] (toList errPositions)
				)
instance Html5ify Body where
	html5ify body = do
		liftStateMarkup $ S.modify' $ \s -> s{state_section = body}
		mapM_ html5ify body
		case Seq.viewr body of
		 _ Seq.:> Tree BodyBlock{} _ -> do
			notes <- liftStateMarkup $ 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{..}} <- liftStateMarkup S.get
			liftStateMarkup $ S.modify' $ \s -> s{state_section = bs}
			do -- notes
				let mayNotes = do
					sectionPosPath <- dropSelfPosPath $ xmlPos_Ancestors xmlPos
					let (sectionNotes, notes) = Map.updateLookupWithKey (\_ _ -> Nothing) sectionPosPath $ state_notes st
					(,notes) <$> sectionNotes
				case mayNotes of
				 Nothing -> mempty
				 Just (sectionNotes, state_notes) -> do
					liftStateMarkup $ S.modify' $ \s -> s{state_notes}
					html5Notes sectionNotes
			html5CommonAttrs attrs{classes="section":classes attrs, id=Nothing} $
				H.section ! HA.id (attrify $ identify xmlPos) $$ do
					forM_ aliases html5ify
					do -- judgments
						let sectionJudgments = state_judgments st `HS.union` HS.fromList 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
						liftStateMarkup $ 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
							liftStateMarkup $ 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 judgments
								forM_ (HM.toList opinsBySectionByJudgment) $ \(judgment@Judgment{question},opinsBySection) -> do
									H.div ! HA.class_ "judgment section-judgment" $$ do
										let choices = maybe [] snd $ HM.lookup judgment choicesJ
										let opins   = List.head opinsBySection
										html5Judgment question choices opins
					let mayId =
						case toList <$> HM.lookup title all_section of
						 Just [_] -> Just $ identifyTitle (Plain.state_l10n $ state_plainify st) 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 $ xmlPos_Ancestors xmlPos
								H.td ! HA.class_ "section-title" $$ do
									(case List.length $ xmlPos_Ancestors xmlPos of
									 0 -> H.h1
									 1 -> H.h2
									 2 -> H.h3
									 3 -> H.h4
									 4 -> H.h5
									 5 -> H.h6
									 _ -> H.h6) $$
										html5ify title
					forM_ bs html5ify
					do -- judgments
						liftStateMarkup $ S.modify' $ \s ->
							s{ state_judgments = state_judgments st }
					do -- notes
						notes <- liftStateMarkup $ S.gets state_notes
						maybe mempty html5Notes $
							Map.lookup (xmlPos_Ancestors xmlPos) notes
			liftStateMarkup $ 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 xmlPos) $$ do
			H.span ! HA.class_ "toc-name" $$
				H.a ! HA.href (refIdent $ identify xmlPos) $$ do
					Loqualization l10n <- liftStateMarkup $ S.gets state_l10n
					Plain.l10n_Table_of_Contents l10n
			H.ul $$ do
				State{state_section} <- liftStateMarkup S.get
				forM_ state_section $ html5ifyToC depth
	 BlockToF{..} -> do
		H.nav ! HA.class_ "tof"
		      ! HA.id (attrify $ identify xmlPos) $$
			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 $ Ident $ Plain.text def $ xmlPos_AncestorsWithFigureNames xmlPos
		 } $
		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 xmlPos) $$ mempty
						 else
							H.td ! HA.class_ "figure-number" $$ do
								H.a ! HA.href (refIdent $ identify $ xmlPos_AncestorsWithFigureNames xmlPos) $$ do
									html5ify type_
									html5ify $ xmlPos_AncestorsWithFigureNames xmlPos
						forM_ mayTitle $ \title -> do
							H.td ! HA.class_ "figure-colon" $$ do
								unless (TL.null type_) $ do
									Loqualization l10n <- liftStateMarkup $ 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{xmlPos} -> do
		st@State{..} <- liftStateMarkup S.get
		liftStateMarkup $ S.put st
		 { state_styles = HS.insert (Left "dtc-index.css") state_styles }
		let (allTerms,refsByTerm) = state_indexs Map.!xmlPos
		let chars = Index.termsByChar allTerms
		H.div ! HA.class_ "index"
		      ! HA.id (attrify $ identify xmlPos) $$ do
			H.nav ! HA.class_ "index-nav" $$ do
				forM_ (Map.keys chars) $ \char ->
					H.a ! HA.href (refIdent (identify xmlPos <> "." <> identify char)) $$
						html5ify char
			H.dl ! HA.class_ "index-chars" $$
				forM_ (Map.toList chars) $ \(char,terms) -> do
					H.dt $$ do
						let i = identify xmlPos <> "." <> 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` DTC.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 count) $$
										html5ify $ xmlPos_Ancestors section
	 BlockReferences{..} ->
		html5CommonAttrs attrs
		 { classes = "references":classes attrs
		 , DTC.id  = Just $ Ident $ Plain.text def $ xmlPos_Ancestors xmlPos
		 } $
		H.div $$ do
			H.table $$
				forM_ refs html5ify
	 BlockGrades{..} ->
		html5CommonAttrs attrs
		 { classes = "grades":classes attrs
		 , DTC.id  = Just $ Ident $ Plain.text def $ xmlPos_Ancestors xmlPos
		 } $
		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{..} ->
		html5CommonAttrs attrs
		 { classes = "judges":classes attrs
		 , DTC.id  = Just $ Ident $ Plain.text def $ xmlPos_Ancestors xmlPos
		 } $
		H.div $$ do
			mempty
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_ xmlPos
		 } $
		H.div $$
			forM_ items $ \item ->
				html5AttrClass (cls item) $
				html5ify item
	 where
		id_ = Just . Ident . Plain.text def . xmlPos_Ancestors
		cls = \case
		 ParaPlain{}     -> []
		 ParaArtwork{..} -> ["artwork", "artwork-"<>type_]
		 ParaQuote{..}   -> ["quote", "quote-"<>type_]
		 ParaComment{}   -> []
		 ParaOL{}        -> ["ol"]
		 ParaUL{}        -> ["ul"]
		 ParaJudgment{}  -> ["judgment"]
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 Judgment where
 html5ify Judgment{..} = do
	st <- liftStateMarkup S.get
	H.div $$ do
		let judgmentGrades =
			maybe (Prelude.error $ show grades) MJ.grades $ -- unknown grades
			HM.lookup grades (Collect.all_grades $ state_collect st)
		let judgmentJudges =
			fromMaybe (Prelude.error $ show judges) $ -- unknown judges
			HM.lookup judges (Collect.all_judges $ state_collect st)
		let defaultGradeByJudge =
			let defaultGrade =
				List.head
				 [ g | g <- Set.toList judgmentGrades
				 , isDefault $ MJ.unRank g
				 ] in
			HM.fromList
			 [ (name, defaultGrade`fromMaybe`judgeDefaultGrade)
			 | DTC.Judge{name,defaultGrades} <- judgmentJudges
			 , let judgeDefaultGrade = do
				jdg <- listToMaybe [g | (n,g) <- defaultGrades, n == grades]
				listToMaybe
				 [ g | g <- Set.toList judgmentGrades
				 , let DTC.Grade{name=n} = MJ.unRank g
				 , n == jdg
				 ]
			 ]
		judgmentChoices <- forM choices $ \c@DTC.Choice{opinions} -> do
			gradeByJudge <- forM opinions $ \DTC.Opinion{judge,grade} -> do
				let grd =
					fromMaybe (Prelude.error $ show grade) $ -- unknown grade
					listToMaybe
					 [ MJ.singleGrade g | g <- Set.toList judgmentGrades
					 , let Grade{name} = MJ.unRank g
					 , name == grade
					 ]
				return (judge, grd)
			case MJ.opinions defaultGradeByJudge $ HM.fromList gradeByJudge of
			 (ok,ko) | null ko   -> return (c, ok)
			         | otherwise -> Prelude.error $ show ko -- unknown judge
			-- TODO: handle ko
		html5Judgment question choices $ HM.fromList judgmentChoices
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 <- liftStateMarkup $ 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
		liftStateMarkup $
			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 number of
		 Nothing -> Prelude.error "[BUG] PlainNote has no number."
		 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 <- liftStateMarkup $ S.gets state_l10n
			Plain.l10n_Quote (html5ify $ Tree PlainI ls) l10n
	 PlainEref{..} ->
		H.a ! HA.class_ "eref"
		    ! HA.href (attrify href) $$
			if null ls
			then html5ify $ unURL href
			else html5ify ls
	 PlainIref{..} ->
		case anchor of
		 Nothing -> html5ify ls
		 Just Anchor{count} ->
			H.span ! HA.class_ "iref"
			       ! HA.id (attrify $ identifyIrefCount term count) $$
				html5ify ls
	 PlainTag{error} -> do
		st <- liftStateMarkup S.get
		let l10n = Plain.state_l10n $ state_plainify st
		case 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 error of
		 Nothing ->
			let ref = do
				"["::HTML5
				H.a ! HA.class_ "reference"
				    ! HA.href (refIdent $ identifyReference "" to Nothing)
				    ! HA.id (attrify $ identifyReference "" to number) $$
					html5ify to
				"]" in
			case toList ls of
			 [] -> ref
			 [Tree (PlainText "") _] -> do
				refs <- liftStateMarkup $ S.gets $ Collect.all_reference . state_collect
				case toList <$> HM.lookup to refs of
				 Just [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 "" to Nothing)
				    ! HA.id (attrify $ identifyReference "" to 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" to $ Just num) $$
				html5ify 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" to . Just <$> num) $$
				html5ify to
			"]"
instance Html5ify [Title] where
	html5ify =
		html5ify . fold . List.intersperse sep . toList
		where sep = Title $ Seq.singleton $ tree0 $ PlainText " — "
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 <- liftStateMarkup $ 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{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{..}} <- liftStateMarkup 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 <- liftStateMarkup $ 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
				 { number = Nothing
				 , tctPos = def
				 , to     = id
				 , error  = (<$> error) $ \case
					 ErrorAnchor_Ambiguous num -> ErrorTarget_Ambiguous (Just num)
				 }
			H.td ! HA.class_ "reference-content" $$ do
				html5ify about
				rrefs <- liftStateMarkup $ S.gets state_rrefs
				case HM.lookup 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 "" id $ Just num) $$
								case maySection of
								 Nothing -> "0"::HTML5
								 Just Section{xmlPos=posSection} -> html5ify $ xmlPos_Ancestors posSection
instance Html5ify XmlPosPath 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 <- liftStateMarkup $ S.gets state_plainify
		let (t,sp') = Plain.runPlain p sp
		html5ify t
		liftStateMarkup $ 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

html5AttrClass :: [TL.Text] -> HTML5 -> HTML5
html5AttrClass = \case
 [] -> Cat.id
 cls  ->
	Compose .
	(H.AddCustomAttribute "class"
	 (H.String $ TL.unpack $ TL.unwords cls) <$>) .
	getCompose

html5AttrId :: Ident -> HTML5 -> HTML5
html5AttrId (Ident id_) =
	Compose .
	(H.AddCustomAttribute "id"
	 (H.String $ TL.unpack id_) <$>) .
	getCompose

html5CommonAttrs :: CommonAttrs -> HTML5 -> HTML5
html5CommonAttrs CommonAttrs{id=id_, ..} =
	html5AttrClass classes .
	maybe Cat.id html5AttrId id_

html5SectionNumber :: XmlPosPath -> HTML5
html5SectionNumber = go mempty
	where
	go :: XmlPosPath -> XmlPosPath -> 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 :: XmlPosPath -> 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 $ xmlPos_Ancestors xmlPos
						H.td ! HA.class_ "section-title" $$
							html5ify $ cleanPlain $ unTitle 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 <- liftStateMarkup $ 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) $ \(xmlPos, (type_, title)) ->
		H.tr $$ do
			H.td ! HA.class_ "figure-number" $$
				H.a ! HA.href (refIdent $ identify xmlPos) $$ do
					html5ify type_
					html5ify $ xmlPos_Ancestors xmlPos
			forM_ title $ \ti ->
				H.td ! HA.class_ "figure-title" $$
					html5ify $ cleanPlain $ unTitle ti

html5Judgment ::
 Maybe Title ->
 [Choice] ->
 MJ.OpinionsByChoice Choice Name (MJ.Ranked Grade) ->
 HTML5
html5Judgment question choices distByJudgeByChoice = do
	let commentJGC = HM.fromList
		[ (choice_, HM.fromListWith (<>)
			[ (grade, HM.singleton judge comment)
			| Opinion{..} <- opinions ])
		| choice_@Choice{opinions} <- choices ]
	case question of
	 Nothing -> mempty
	 Just title -> H.div ! HA.class_ "question" $$ html5ify title
	H.dl ! HA.class_ "choices" $$ do
		let meritByChoice@(MJ.MeritByChoice meritC) = MJ.meritByChoice distByJudgeByChoice
		let ranking = MJ.majorityRanking meritByChoice
		forM_ ranking $ \(choice_@DTC.Choice{title}, majorityValue) -> do
			H.dt ! HA.class_ "choice-title" $$ do
				html5ify title
			H.dd ! HA.class_ "choice-merit" $$ do
				let distByJudge = distByJudgeByChoice HM.!choice_
				let numJudges   = HM.size distByJudge
				html5MeritHistogram majorityValue numJudges
				let grades    = Map.keys $ MJ.unMerit $ meritC HM.!choice_
				let commentJG = HM.lookup choice_ commentJGC
				html5MeritComments distByJudge grades commentJG

html5MeritComments ::
 MJ.Opinions Name (MJ.Ranked Grade) ->
 [MJ.Ranked Grade] ->
 Maybe (HM.HashMap Name (HM.HashMap Name (Maybe Title))) ->
 HTML5
html5MeritComments distJ grades commentJG = do
	Loqualization l10n <- liftStateMarkup $ S.gets state_l10n
	H.ul ! HA.class_ "merit-comments" $$ do
		forM_ grades $ \grade@(MJ.unRank -> DTC.Grade{name=grade_name, color}) -> do
			let commentJ = commentJG >>= HM.lookup grade_name
			let judgesWithComment =
				-- FIXME: sort accents better: « e é f » not « e f é »
				List.sortOn (TL.map Char.toLower . unName . (\(j,_,_) -> j))
				 [ (judge, importance, commentJ >>= HM.lookupDefault Nothing judge)
				 | (judge, dist) <- HM.toList distJ
				 , importance <- maybeToList $ Map.lookup grade dist ]
			forM_ judgesWithComment $ \(judge, importance, comment) ->
				H.li ! HA.class_ ("merit-comment" <> if isJust comment then " judge-comment" else "") $$ do
					H.span
					 ! HA.class_ ("judge" <> if judge`HM.member`fromMaybe HM.empty commentJ then "" else " inactive")
					 ! HA.style ("color:"<>attrify color<>";") $$ do
						unless (importance == 1) $ do
							H.span ! HA.class_ "section-importance" $$ do
								let percent =
									(round::Double -> Int) $
									fromRational $ importance * 100
								html5ify $ show percent
								"%"::HTML5
						html5ify judge
					case comment of
					 Nothing -> mempty
					 Just p -> do
						Plain.l10n_Colon l10n :: HTML5
						html5ify p

html5MeritHistogram :: MJ.MajorityValue (MJ.Ranked Grade) -> Int -> HTML5
html5MeritHistogram (MJ.MajorityValue majVal) numJudges = do
	H.div ! HA.class_ "merit-histogram" $$ do
		forM_ majVal $ \(MJ.unRank -> DTC.Grade{name=grade_name, title=grade_title, color},count) -> do
			let percent :: Double =
				fromRational $ (toRational $ (ceiling::Double -> Int) $ fromRational $
				(count / toRational numJudges) * 100 * 1000) / 1000
			let bcolor  = "background-color:"<>attrify color<>";"
			let width   = "width:"<>attrify percent<>"%;"
			let display = if percent == 0 then "display:none;" else ""
			H.div
			 ! HA.class_ "merit-grade"
			 ! HA.alt (attrify grade_name) -- FIXME: do not work
			 ! HA.style (bcolor<>display<>width) $$ do
				H.div
				 ! HA.class_ "grade-name" $$ do
					case grade_title of
					 Nothing -> html5ify grade_name
					 Just t  -> html5ify t

html5Judgments :: HTML5
html5Judgments = do
	Collect.All{..} <- liftStateMarkup $ S.gets state_collect
	opinionsByChoiceByNodeBySectionByJudgment <-
		forM (HM.toList all_judgments) $ \(judgment@Judgment{judges,grades}, choicesBySection) -> do
			-- WARNING: only the fields of 'Judgment' used in its 'Hashable' instance
			-- can safely be used here: 'judges' and 'grades' are ok
			let judgmentGrades =
				maybe (Prelude.error $ show grades) MJ.grades $ -- unknown grades
				HM.lookup grades all_grades
			let judgmentJudges =
				fromMaybe (Prelude.error $ show judges) $ -- unknown judges
				HM.lookup judges all_judges
			let defaultGradeByJudge =
				let defaultGrade =
					List.head
					 [ g | g <- Set.toList judgmentGrades
					 , isDefault $ MJ.unRank g
					 ] in
				HM.fromList
				 [ (name, defaultGrade`fromMaybe`judgeDefaultGrade)
				 | DTC.Judge{name,defaultGrades} <- judgmentJudges
				 , let judgeDefaultGrade = do
					jdg <- listToMaybe [g | (n,g) <- defaultGrades, n == grades]
					listToMaybe
					 [ g | g <- Set.toList judgmentGrades
					 , let DTC.Grade{name=n} = MJ.unRank g
					 , n == jdg
					 ]
				 ]
			opinionsByChoiceByNodeBySection <-
				forM choicesBySection $ \choicesTree -> do
					judgmentTree <- forM choicesTree $ \(section_importance, choices) -> do
						judgmentOpinions <- forM choices $ \choice_@DTC.Choice{opinions} -> do
							gradeByJudge <- forM opinions $ \DTC.Opinion{judge,grade,importance} -> do
								case listToMaybe
									 [ g | g <- Set.toList judgmentGrades
									 , let Grade{name} = MJ.unRank g
									 , name == grade
									 ] of
								 Just grd -> return (judge, MJ.Section importance (Just grd))
								 Nothing -> Prelude.error $ show grade -- unknown grade
							return (choice_, HM.fromList gradeByJudge)
						return $ MJ.SectionNode section_importance $ HM.fromList judgmentOpinions
					let judgmentChoices = HS.fromList $ snd $ Tree.rootLabel choicesTree
					  -- NOTE: choices are determined by those at the root Tree.Node.
					-- NOTE: core Majority Judgment calculus handled here by MJ
					case MJ.opinionsBySection judgmentChoices defaultGradeByJudge judgmentTree of
					 Right opinionsByChoiceByNode -> return opinionsByChoiceByNode
					 Left err -> Prelude.error $ show err -- unknown choice, unknown judge, invalid shares
			-- NOTE: 'toList' returns a self-then-descending-then-following traversal of a 'Tree',
			-- this will match perfectly withw the 'html5ify' traversal:
			-- 'BodySection' by 'BodySection'.
			return (judgment, join $ toList <$> opinionsByChoiceByNodeBySection)
	liftStateMarkup $ S.modify' $ \st ->
		st{state_opinions = HM.fromList opinionsByChoiceByNodeBySectionByJudgment}

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

-- * Class 'L10n'
class
 ( Plain.L10n msg lang
 , Plain.L10n TL.Text lang
 ) => L10n msg lang where
	l10n_Header_Address :: FullLocale lang -> msg
	l10n_Header_Date    :: FullLocale lang -> msg
	l10n_Header_Version :: FullLocale lang -> msg
	l10n_Header_Origin  :: FullLocale lang -> msg
	l10n_Header_Source  :: FullLocale lang -> msg
	l10n_Errors_All                :: FullLocale lang -> Nat -> msg
	l10n_Error_Tag_unknown         :: FullLocale lang -> msg
	l10n_Error_Tag_ambiguous       :: FullLocale lang -> msg
	l10n_Error_Rref_unknown        :: FullLocale lang -> msg
	l10n_Error_Reference_ambiguous :: FullLocale lang -> msg
instance L10n HTML5 EN where
	l10n_Header_Address _l10n = "Address"
	l10n_Header_Date    _l10n = "Date"
	l10n_Header_Origin  _l10n = "Origin"
	l10n_Header_Source  _l10n = "Source"
	l10n_Header_Version _l10n = "Version"
	l10n_Errors_All _l10n n = "All errors ("<>html5ify n<>")"
	l10n_Error_Tag_unknown         _l10n = "Unknown tag"
	l10n_Error_Tag_ambiguous       _l10n = "Ambiguous tag"
	l10n_Error_Rref_unknown        _l10n = "Unknown reference"
	l10n_Error_Reference_ambiguous _l10n = "Ambiguous reference"
instance L10n HTML5 FR where
	l10n_Header_Address _l10n = "Adresse"
	l10n_Header_Date    _l10n = "Date"
	l10n_Header_Origin  _l10n = "Origine"
	l10n_Header_Source  _l10n = "Source"
	l10n_Header_Version _l10n = "Version"
	l10n_Errors_All _l10n n = "Toutes les erreurs ("<>html5ify n<>")"
	l10n_Error_Tag_unknown         _l10n = "Tag inconnu"
	l10n_Error_Tag_ambiguous       _l10n = "Tag ambigu"
	l10n_Error_Rref_unknown        _l10n = "Référence inconnue"
	l10n_Error_Reference_ambiguous _l10n = "Référence ambiguë"

instance Plain.L10n HTML5 EN where
	l10n_Colon             l10n = html5ify (Plain.l10n_Colon l10n :: TL.Text)
	l10n_Table_of_Contents l10n = html5ify (Plain.l10n_Table_of_Contents l10n :: TL.Text)
	l10n_Date date         l10n = html5ify (Plain.l10n_Date date l10n :: TL.Text)
	l10n_Quote msg _l10n = do
		depth <- liftStateMarkup $ S.gets $ Plain.state_quote . state_plainify
		let (o,c) :: (HTML5, HTML5) =
			case unNat depth `mod` 3 of
			 0 -> ("“","”")
			 1 -> ("« "," »")
			 _ -> ("‟","„")
		o
		setDepth $ succNat depth
		msg
		setDepth $ depth
		c
		where
		setDepth d =
			liftStateMarkup $ S.modify' $ \s ->
				s{state_plainify=(state_plainify s){Plain.state_quote=d}}
instance Plain.L10n HTML5 FR where
	l10n_Colon             l10n = html5ify (Plain.l10n_Colon l10n :: TL.Text)
	l10n_Table_of_Contents l10n = html5ify (Plain.l10n_Table_of_Contents l10n :: TL.Text)
	l10n_Date date         l10n = html5ify (Plain.l10n_Date date l10n :: TL.Text)
	l10n_Quote msg _l10n = do
		depth <- liftStateMarkup $ S.gets $ Plain.state_quote . state_plainify
		let (o,c) :: (HTML5, HTML5) =
			case unNat depth `mod` 3 of
			 0 -> ("« "," »")
			 1 -> ("“","”")
			 _ -> ("‟","„")
		o
		setDepth $ succNat depth
		msg
		setDepth $ depth
		c
		where
		setDepth d =
			liftStateMarkup $ S.modify' $ \s ->
				s{state_plainify=(state_plainify s){Plain.state_quote=d}}