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

import Control.Applicative (Applicative(..))
import Control.Category as Cat
import Control.Monad
import Data.Bool
import Data.Char (Char)
import Data.Default.Class (Default(..))
import Data.Foldable (Foldable(..), concat)
import Data.Function (($), const, flip, on)
import Data.Functor (Functor(..), (<$>))
import Data.Functor.Compose (Compose(..))
import Data.Int (Int)
import Data.Map.Strict (Map)
import Data.Maybe (Maybe(..), maybe, mapMaybe, fromJust, maybeToList)
import Data.Monoid (Monoid(..))
import Data.Ord (Ord(..))
import Data.Semigroup (Semigroup(..))
import Data.String (String, IsString(..))
import Data.Text (Text)
import Data.Traversable (Traversable(..))
import Data.TreeSeq.Strict (Tree(..), tree0)
import Data.Tuple (snd)
import Prelude (undefined)
import System.FilePath (FilePath)
import Text.Blaze ((!))
import Text.Blaze.Html (Html)
import Text.Show (Show(..))
import qualified Control.Monad.Trans.State as S
import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.Sequence as Seq
import qualified Data.Strict.Maybe as Strict
import qualified Data.Text as Text
import qualified Data.Text.Lazy as TL
import qualified Data.TreeMap.Strict as TreeMap
import qualified Data.TreeSeq.Strict.Zipper as Tree
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 Data.Locale hiding (Index)
import qualified Data.Locale as Locale

import Language.DTC.Document as DTC
import Language.DTC.Utils
import Language.DTC.Write.Plain (Plainify(..))
import Language.DTC.Write.XML ()
import qualified Language.DTC.Anchor as Anchor
import qualified Language.DTC.Write.Plain as Plain

document ::
 Localize locales Plain.Plain Plain.L10n =>
 Localize locales Html5 L10n =>
 Locales  locales =>
 LocaleIn locales -> DTC.Document -> Html
document locale DTC.Document{..} = do
	let titles = DTC.titles $ DTC.about (head :: Head)
	let Keys{..} = keys body `S.execState` def
	let (body',state_rrefs,state_notes,state_indexs) =
		let irefs = foldMap Anchor.irefsOfTerms keys_index in
		let (body0, Anchor.State{state_irefs, state_rrefs=rrefs, state_notes=notes}) =
			Anchor.anchorify body `S.runState`
			def{Anchor.state_irefs=irefs} in
		(body0,rrefs,notes,) $
		(<$> keys_index) $ \terms ->
			(terms,) $
			TreeMap.intersection const state_irefs $
			Anchor.irefsOfTerms terms
	let state_plainify = def
		{ Plain.state_localize = Locale.localize locale }
	let (html5Body, State{state_styles,state_scripts}) =
		runStateMarkup def
		 { state_indexs
		 , state_rrefs
		 , state_notes
		 , state_figures    = keys_figure
		 , state_references = keys_reference
		 , state_plainify
		 , state_localize = Locale.localize locale
		 } $ do
			html5Head head
			unless (null titles) $
				H.div ! HA.class_ "title" $$ do
					forM_ titles $ \title ->
						H.h1 $$ html5ify title
			html5ify body'
	
	H.docType
	H.html ! HA.lang (attrify $ countryCode locale) $ do
		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_ (DTC.links $ DTC.about (head :: Head)) $ \Link{rel, href} ->
				H.link ! HA.rel (attrify rel)
				       ! HA.href (attrify href)
			H.meta ! HA.name "generator"
			       ! HA.content "https://hackage.haskell.org/package/hdoc"
			let chapters =
				(`mapMaybe` toList body) $ \case
				 Tree k@BodySection{} _ -> Just k
				 _ -> Nothing
			forM_ chapters $ \case
			 BodySection{..} ->
				H.link ! HA.rel "Chapter"
				       ! HA.title (attrify $ plainify title)
				       ! HA.href ("#"<>attrify pos)
			 _ -> mempty
			H.link ! HA.rel "stylesheet"
			       ! HA.type_ "text/css"
			       ! HA.href "style/dtc-html5.css"
			forM_ state_styles $ \style ->
				H.style ! HA.type_ "text/css" $
					H.toMarkup style
			forM_ state_scripts $ \script ->
				H.script ! HA.type_ "application/javascript" $
					H.toMarkup script
		H.body $
			html5Body

html5Head :: Head -> Html5
html5Head Head{DTC.about=About{..}} = do
	H.table ! HA.class_ "document-header headers" $$ do
		H.tbody $$ do
			forM_ rows $ \case
			 [left, right] ->
				H.tr $$ do
					H.td ! HA.class_ "left"  $$ left
					H.td ! HA.class_ "right" $$ right
			 _ -> undefined -- NOTE: cannot happen because of rows' definition
	where
	rows = padded $ traverse (`PaddedList` mempty) [lefts, rights]
	lefts :: [Html5]
	lefts =
		List.concat
		 [ (<$> series) $ html5ify
		 , (<$> maybeToList version) $ \v -> do
			H.span ! HA.class_ "header-name" $$ do
				html5ify L10n_Header_Version
				html5ify Plain.L10n_Colon
			html5ify v
		 , (<$> maybeToList date) $ \d -> do
			H.span ! HA.class_ "header-name" $$ do
				html5ify L10n_Header_Date
				html5ify Plain.L10n_Colon
			html5ify d
		 , (<$> links) $ \Link{..} -> do
			H.span ! HA.class_ "header-name" $$ do
				html5ify name
				html5ify Plain.L10n_Colon
			H.a ! HA.href (attrify href) $$
				html5ify plain
		 ]
	rights :: [Html5]
	rights =
		List.concat
		 [ (<$> authors) $ html5ify
		 ]

{-
 {   titles   :: [Title]
 ,   url      :: Maybe URL
 ,   authors  :: [Entity]
 ,   editor   :: Maybe Entity
 ,   date     :: Maybe Date
 ,   version  :: MayText
 ,   keywords :: [TL.Text]
 ,   links    :: [Link]
 ,   series   :: [Serie]
 ,   includes :: [Include]
-}

(<&>) :: Functor f => f a -> (a -> b) -> f b
(<&>) = flip (<$>)
infixl 4 <&>

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

-- * Type 'State'
data State
 =   State
 {   state_styles     :: Map FilePath CSS
 ,   state_scripts    :: Map FilePath Script
 ,   state_indexs     :: Map DTC.Pos (Terms, Anchor.Irefs)
 ,   state_rrefs      :: Anchor.Rrefs
 ,   state_figures    :: Map TL.Text (Map DTC.Pos (Maybe Title))
 ,   state_references :: Map Ident About
 ,   state_notes      :: Anchor.Notes
 ,   state_plainify   :: Plain.State
 ,   state_localize   :: L10n -> Html5
 }
instance Default State where
	def = State
	 { state_styles     = def
	 , state_scripts    = def
	 , state_indexs     = def
	 , state_rrefs      = def
	 , state_figures    = def
	 , state_references = def
	 , state_notes      = def
	 , state_plainify   = def
	 , state_localize   = html5ify . show
	 }
type CSS = Text
type Script = Text

-- * Type 'Keys'
data Keys
 = Keys
 { keys_index     :: Map DTC.Pos Terms
 , keys_figure    :: Map TL.Text (Map DTC.Pos (Maybe Title))
 , keys_reference :: Map Ident About
 } deriving (Show)
instance Default Keys where
	def = Keys mempty mempty mempty

-- ** Class 'KeysOf'
class KeysOf a where
	keys :: a -> S.State Keys ()
instance KeysOf Body where
	keys = mapM_ keys
instance KeysOf (Tree BodyNode) where
	keys (Tree n ts) =
		case n of
		 BodySection{..} -> keys ts
		 BodyBlock b -> keys b
instance KeysOf DTC.Block where
	keys = \case
	 BlockPara{} -> return ()
	 BlockToC{}  -> return ()
	 BlockToF{}  -> return ()
	 BlockIndex{..} ->
		S.modify $ \s -> s{keys_index=
			Map.insert pos terms $ keys_index s}
	 BlockFigure{..} ->
		S.modify $ \s -> s{keys_figure=
			Map.insertWith (<>)
			 type_ (Map.singleton pos mayTitle) $
			keys_figure s}
	 BlockReferences{..} ->
		S.modify $ \s -> s{keys_reference=
			foldr
			 (\r -> Map.insert
				 (DTC.id    (r::DTC.Reference))
				 (DTC.about (r::DTC.Reference)))
			 (keys_reference s)
			 refs}

-- * 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 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

-- * Type 'BodyCursor'
-- | Cursor to navigate within a 'Body' according to many axis (like in XSLT).
type BodyCursor = Tree.Zipper BodyNode
instance Html5ify Body where
	html5ify body =
		forM_ (Tree.zippers body) $ \z ->
			forM_ (Tree.axis_repeat Tree.axis_following_sibling_nearest `Tree.runAxis` z) $
				html5ify
instance Html5ify BodyCursor
 where html5ify z =
	let Tree n _ts = Tree.current z in
	case n of
	 BodyBlock BlockToC{..} -> do
		H.nav ! HA.class_ "toc"
		      ! HA.id (attrify pos) $$ do
			H.span ! HA.class_ "toc-name" $$
				H.a ! HA.href (attrify pos) $$
					html5ify Plain.L10n_Table_of_Contents
			H.ul $$
				forM_ (Tree.axis_following_sibling `Tree.runAxis` z) $
					html5ifyToC depth
	 BodyBlock b -> html5ify b
	 BodySection{..} -> do
		do
			notes <- liftStateMarkup $ S.gets state_notes
			let mayNotes = do
				p <- posParent $ posAncestors pos
				let (ns, as) = Map.updateLookupWithKey (\_ _ -> Nothing) p notes
				(,as) <$> ns
			case mayNotes of
			 Nothing -> mempty
			 Just (secNotes, state_notes) -> do
				liftStateMarkup $ S.modify' $ \s -> s{state_notes}
				html5ify secNotes
		H.section ! HA.class_ "section"
		          ! HA.id (attrify pos) $$ do
			forM_ aliases html5ify
			html5CommonAttrs attrs{classes="section-header":classes attrs} $
				H.table $$
					H.tbody $$
						H.tr $$ do
							H.td ! HA.class_ "section-number" $$ do
								html5SectionNumber $ DTC.posAncestors pos
							H.td ! HA.class_ "section-title" $$ do
								(case List.length $ DTC.posAncestors pos of
								 0 -> H.h1
								 1 -> H.h2
								 2 -> H.h3
								 3 -> H.h4
								 4 -> H.h5
								 5 -> H.h6
								 _ -> H.h6) $$
									html5ify title
			forM_ (Tree.axis_child `Tree.runAxis` z) $
				html5ify
			notes <- liftStateMarkup $ S.gets state_notes
			html5ify $ Map.lookup (posAncestors pos) notes
instance Html5ify [Anchor.Note] where
	html5ify notes =
		H.aside ! HA.class_ "notes" $$ do
			Compose $ pure H.hr
			H.table $$
				H.tbody $$
					forM_ (List.reverse notes) $ \Anchor.Note{..} ->
						H.tr $$ do
							H.td ! HA.class_ "note-ref" $$ do
								H.a ! HA.class_ "note-number"
								    ! HA.id   ("note."<>attrify note_number)
								    ! HA.href ("#note."<>attrify note_number) $$ do
									html5ify note_number
								". "::Html5
								H.a ! HA.href ("#note-ref."<>attrify note_number) $$ do
									"↑"
							H.td $$
								html5ify note_content
instance Html5ify Block where
	html5ify = \case
	 BlockPara para -> html5ify para
	 BlockToC{..} -> mempty -- NOTE: done in Html5ify BodyCursor
	 BlockToF{..} -> do
		H.nav ! HA.class_ "tof"
		      ! HA.id (attrify pos) $$
			H.table ! HA.class_ "tof" $$
				H.tbody $$
					html5ifyToF types
	 BlockFigure{..} ->
		html5CommonAttrs attrs
		 { classes = "figure":("figure-"<>type_):classes attrs
		 , DTC.id  = Just $ Ident $ Plain.text def $ DTC.posAncestors pos
		 } $
		H.div $$ do
			H.table ! HA.class_ "figure-caption" $$
				H.tbody $$
					H.tr $$ do
						if TL.null type_
						 then H.a ! HA.href ("#"<>attrify pos) $$ mempty
						 else
							H.td ! HA.class_ "figure-number" $$ do
								H.a ! HA.href ("#"<>attrify pos) $$ do
									html5ify type_
									html5ify $ DTC.posAncestors pos
						forM_ mayTitle $ \title ->
							H.td ! HA.class_ "figure-title" $$ do
								unless (TL.null type_) $
									html5ify $ Plain.L10n_Colon
								html5ify title
			H.div ! HA.class_ "figure-content" $$ do
				html5ify paras
	 BlockIndex{pos} -> do
		(allTerms,refsByTerm) <- liftStateMarkup $ S.gets $ (Map.! pos) . state_indexs
		let chars = Anchor.termsByChar allTerms
		H.div ! HA.class_ "index"
		      ! HA.id (attrify pos) $$ do
			H.nav ! HA.class_ "index-nav" $$ do
				forM_ (Map.keys chars) $ \char ->
					H.a ! HA.href ("#"<>(attrify pos <> "." <> attrify char)) $$
						html5ify char
			H.dl ! HA.class_ "index-chars" $$
				forM_ (Map.toList chars) $ \(char,terms) -> do
					H.dt $$
						let i = attrify pos <> "." <> attrify char in
						H.a ! HA.id i
						    ! HA.href ("#"<>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 ->
										H.li ! HA.id (attrifyIref term) $$
											html5ify term
							H.dd $$
								let anchs =
									List.sortBy (compare `on` DTC.section . snd) $
									(`foldMap` aliases) $ \words ->
										fromJust $ do
											path <- Anchor.pathFromWords words
											Strict.maybe Nothing (Just . ((words,) <$>) . List.reverse) $
												TreeMap.lookup path refsByTerm in
								html5CommasDot $
								(<$> anchs) $ \(term,DTC.Anchor{..}) ->
									H.a ! HA.class_ "index-iref"
									    ! HA.href ("#"<>attrifyIrefCount term count) $$
										html5ify $ DTC.posAncestors section
	 BlockReferences{..} ->
		html5CommonAttrs attrs
		 { classes = "references":classes attrs
		 , DTC.id  = Just $ Ident $ Plain.text def $ DTC.posAncestors pos
		 } $
		H.div $$ do
			H.table $$
				forM_ refs html5ify

html5ifyToC :: Maybe DTC.Nat -> BodyCursor -> Html5
html5ifyToC depth z =
	let Tree n _ts = Tree.current z in
	case n of
	 BodySection{..} -> do
		H.li $$ do
			H.table ! HA.class_ "toc-entry" $$
				H.tbody $$
					H.tr $$ do
						H.td ! HA.class_ "section-number" $$
							html5SectionRef $ DTC.posAncestors pos
						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)
	 _ -> pure ()
	where
	sections =
		(`Tree.runAxis` z) $
		Tree.axis_child
		`Tree.axis_filter_current` \case
		 Tree BodySection{} _ -> True
		 _ -> False

html5ifyToF :: [TL.Text] -> Html5
html5ifyToF types = do
	figsByType <- liftStateMarkup $ S.gets state_figures
	let figs =
		Map.foldMapWithKey (\ty -> ((ty,) <$>)) $
		if null types
		then figsByType
		else
			Map.intersection figsByType $
			Map.fromList [(ty,()) | ty <- types]
	forM_ (Map.toList figs) $ \(pos, (type_, title)) ->
		H.tr $$ do
			H.td ! HA.class_ "figure-number" $$
				H.a ! HA.href ("#"<>attrify pos) $$ do
					html5ify type_
					html5ify $ DTC.posAncestors pos
			forM_ title $ \ti ->
				H.td ! HA.class_ "figure-title" $$
					html5ify $ cleanPlain $ unTitle ti

cleanPlain :: Plain -> Plain
cleanPlain ps =
	ps >>= \case
	 Tree PlainIref{} ls -> cleanPlain ls
	 Tree PlainNote{} _  -> mempty
	 Tree n ts -> pure $ Tree n $ cleanPlain ts

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_ pos
		 } $
		H.div $$
			forM_ items $ \item ->
				html5AttrClass (cls item) $
				html5ify item
	 where
		id_ = Just . Ident . Plain.text def . DTC.posAncestors
		cls = \case
		 ParaPlain{}     -> []
		 ParaArtwork{..} -> ["artwork", "artwork-"<>type_]
		 ParaQuote{..}   -> ["quote", "quote-"<>type_]
		 ParaComment{}   -> []
		 ParaOL{}        -> ["ol"]
		 ParaUL{}        -> ["ul"]
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
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
	 PlainBR     -> 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}}
	 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 -> mempty
		 Just num ->
			H.a ! HA.class_ "note-ref"
			    ! HA.id ("note-ref."<>attrify num)
			    ! HA.href ("#note."<>attrify num) $$
				html5ify num
	 PlainQ -> do
		depth <- liftStateMarkup $ do
			depth <- S.gets $ Plain.state_quote . state_plainify
			S.modify $ \s -> s{state_plainify=
				(state_plainify s){Plain.state_quote=
					succNat depth}}
			return depth
		H.span ! HA.class_ "q" $$ do
			html5ify $ Plain.L10n_QuoteOpen depth
			html5ify $ Tree PlainI ls
			html5ify $ Plain.L10n_QuoteClose depth
		liftStateMarkup $
			S.modify $ \s ->
				s{state_plainify=
					(state_plainify s){Plain.state_quote = depth}}
	 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{..} ->
			H.span ! HA.class_ "iref"
			       ! HA.id (attrifyIrefCount term count) $$
				html5ify ls
	 PlainRef{..} ->
		H.a ! HA.class_ "ref"
		    ! HA.href ("#"<>attrify to) $$
		if null ls
		then html5ify to
		else html5ify ls
	 PlainRref{..} -> do
		refs <- liftStateMarkup $ S.gets state_references
		case Map.lookup to refs of
		 Nothing -> do
			"["::Html5
			H.span ! HA.class_ "rref-broken" $$
				html5ify to
			"]"
		 Just About{..} -> do
			unless (null ls) $
				forM_ (List.take 1 titles) $ \(Title title) -> do
					html5ify $ Tree PlainQ $
						case url of
						 Nothing -> title
						 Just u -> pure $ Tree (PlainEref u) title
					" "::Html5
			"["::Html5
			H.a ! HA.class_ "rref"
			    ! HA.href ("#rref."<>attrify to)
			    ! HA.id ("rref."<>attrify to<>maybe "" (\Anchor{..} -> "."<>attrify count) anchor) $$
				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{..} =
		html5CommasDot $ concat $
		 [ html5Titles titles
		 , html5ify <$> authors
		 , html5ify <$> maybeToList date
		 , html5ify <$> maybeToList editor
		 , html5ify <$> series
		 ]
		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 = \case
		 s@Serie{name="RFC", key}
			| TL.all Char.isDigit key ->
			html5SerieHref (URL $ "https://tools.ietf.org/html/rfc"<>key) s
		 s@Serie{name="DOI", key} ->
			html5SerieHref (URL $ "https://dx.doi.org/"<>key) s
		 Serie{..} -> do
			H.a ! HA.class_ "header-name" $$ do
				html5ify name
				html5ify Plain.L10n_Colon
			html5ify key
	 where
		html5SerieHref href Serie{..} = do
			sp <- liftStateMarkup $ S.gets state_plainify
			html5ify $
				Tree PlainEref{href} $
				Seq.fromList
				 [ tree0 $ PlainText $ name
				 , tree0 $ PlainText $ Plain.text sp Plain.L10n_Colon
				 , tree0 $ PlainText key
				 ]
instance Html5ify Entity where
	html5ify Entity{..} = do
		html5ify $
			case () of
			 _ | not (TL.null email) ->
				Tree (PlainEref $ URL $ "mailto:"<>email) $
					pure $ tree0 $ PlainText name
			 _ | Just u <- url ->
				Tree (PlainEref u) $
					pure $ tree0 $ PlainText name
			 _ -> tree0 $ PlainText name
		forM_ org $ \o -> do
			" ("::Html5
			html5ify o
			")"::Html5
instance Html5ify Words where
	html5ify = html5ify . Anchor.plainifyWords
instance Html5ify Alias where
	html5ify Alias{id=id_, ..} = do
		H.a ! HA.class_ "alias"
		    ! HA.id (attrify id_) $$
			mempty
instance Html5ify URL where
	html5ify (URL url) =
		H.a ! HA.class_ "eref"
		    ! HA.href (attrify url) $$
			html5ify url
instance Html5ify Date where
	html5ify = html5ify . Plain.L10n_Date
instance Html5ify Reference where
	html5ify Reference{id=id_, ..} =
		H.tr $$ do
			H.td ! HA.class_ "reference-key" $$
				html5ify $ Tree PlainRref{anchor=Nothing, to=id_} Seq.empty
			H.td ! HA.class_ "reference-content" $$ do
				html5ify about
				rrefs <- liftStateMarkup $ S.gets state_rrefs
				case Map.lookup id_ rrefs of
				 Nothing -> pure ()
				 Just anchs ->
					H.span ! HA.class_ "reference-rrefs" $$
						html5CommasDot $
						(<$> List.reverse anchs) $ \Anchor{..} ->
							H.a ! HA.class_ "reference-rref"
							    ! HA.href ("#rref."<>attrify id_<>"."<>attrify count) $$
								html5ify $ DTC.posAncestors section
instance Html5ify PosPath 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'}

html5CommasDot :: [Html5] -> Html5
html5CommasDot [] = pure ()
html5CommasDot hs = do
	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 :: PosPath -> Html5
html5SectionNumber = go mempty
	where
	go :: PosPath -> PosPath -> Html5
	go prev next =
		case Seq.viewl next of
		 Seq.EmptyL -> pure ()
		 a@(_n,rank) Seq.:< as -> do
			H.a ! HA.href ("#"<>attrify (prev Seq.|>a)) $$
				html5ify $ show rank
			when (not (null as) || null prev) $ do
				html5ify '.'
				go (prev Seq.|>a) as

html5SectionRef :: PosPath -> Html5
html5SectionRef as =
	H.a ! HA.href ("#"<>attrify as) $$
		html5ify as

-- * 'Attrify'
instance Attrify Anchor where
	attrify Anchor{..} = attrify section <> "." <> attrify count
instance Attrify Plain.Plain where
	attrify p = attrify t
		where (t,_) = Plain.runPlain p def
instance Attrify PosPath where
	attrify = attrify . plainify
instance Attrify DTC.Pos where
	attrify = attrify . DTC.posAncestors

attrifyIref :: Words -> H.AttributeValue
attrifyIref term =
	"iref" <> "." <> attrify (Anchor.plainifyWords term)
attrifyIrefCount :: Words -> Nat1 -> H.AttributeValue
attrifyIrefCount term count =
	"iref"
	 <> "." <> attrify (Anchor.plainifyWords term)
	 <> "." <> attrify count

-- * Type 'L10n'
data L10n
 =   L10n_Header_Date
 |   L10n_Header_Version
 deriving (Show)
instance Html5ify L10n where
	html5ify msg = do
		loc <- liftStateMarkup $ S.gets state_localize
		loc msg
instance LocalizeIn EN Html5 L10n where
	localizeIn _ = \case
	 L10n_Header_Date    -> "Date"
	 L10n_Header_Version -> "Version"
instance LocalizeIn FR Html5 L10n where
	localizeIn _ = \case
	 L10n_Header_Date    -> "Date"
	 L10n_Header_Version -> "Version"

instance Html5ify Plain.L10n where
	html5ify = html5ify . plainify
instance Localize ls Plain.Plain Plain.L10n => Localize ls Html5 Plain.L10n where
	localize loc a = html5ify (Locale.localize loc a::Plain.Plain)
instance LocalizeIn FR Html5 Plain.L10n where
	localizeIn loc = html5ify @Plain.Plain . localizeIn loc
instance LocalizeIn EN Html5 Plain.L10n where
	localizeIn loc = html5ify @Plain.Plain . localizeIn loc