{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# 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.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.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.TreeSeq.Strict (Tree(..), tree0)
import Data.Tuple (snd)
import Prelude (mod)
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.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 Language.DTC.Document as DTC
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

writeHTML5 :: Config -> DTC.Document -> Html
writeHTML5 conf@Config{..} DTC.Document{..} = do
	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_l10n = loqualize config_locale}
	let (html5Body, endState) =
		runStateMarkup def
		 { state_indexs
		 , state_rrefs
		 , state_notes
		 , state_figures    = keys_figure
		 , state_references = keys_reference
		 , state_plainify
		 , state_l10n = loqualize config_locale
		 } $ do
			html5DocumentHead head
			html5ify body'
	H.docType
	H.html ! HA.lang (attrify $ countryCode config_locale) $ do
		html5Head conf endState head body
		H.body $ html5Body

html5Head :: Config -> State -> Head -> Body -> Html
html5Head Config{..} State{..} Head{DTC.about=About{..}} body = 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_ links $ \Link{rel, href} ->
			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 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
		unless (any (\DTC.Link{rel} -> rel == "stylesheet") links) $ do
			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" $
					-- NOTE: as a special case, H.style wraps its content into an External,
					-- so it does not HTML-escape its content.
					H.toMarkup css
			forM_ state_styles $ \style ->
				H.style ! HA.type_ "text/css" $
					H.toMarkup style
		unless (any (\DTC.Link{rel} -> rel == "script") links) $ do
			forM_ state_scripts $ \script ->
				H.script ! HA.type_ "application/javascript" $
					H.toMarkup script

html5DocumentHead :: Head -> Html5
html5DocumentHead Head{DTC.about=About{..}} = 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) $
		H.div ! HA.class_ "title" $$ do
			forM_ titles $ \title ->
				H.h1 $$ html5ify title
	where
	docHeaders =
		H.table ! HA.class_ "document-headers" $$
			H.tbody $$ do
				Loqualization loc <- 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_ date $ \d ->
					header $ do
						headerName  $ l10n_Header_Date loc
						headerValue $ html5ify d
				forM_ url $ \href ->
					header $ do
						headerName  $ l10n_Header_Address loc
						headerValue $ html5ify $ tree0 $ PlainEref{href}
				forM_ links $ \Link{..} ->
					unless (TL.null name) $
						header $ do
							headerName  $ html5ify name
							headerValue $ html5ify $ Tree PlainEref{href} plain
				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 h = H.tr ! HA.class_ "header" $$ h
	headerName :: Html5 -> Html5
	headerName h =
		H.td ! HA.class_ "header-name" $$ do
			h
			Loqualization loc <- liftStateMarkup $ S.gets state_l10n
			Plain.l10n_Colon loc
	headerValue :: Html5 -> Html5
	headerValue h =
		H.td ! HA.class_ "header-value" $$ do
			h

-- * 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_locale    :: LocaleIn locales
 ,   config_generator :: TL.Text
 }
instance Default Config where
	def = Config
	 { config_css       = Right "style/dtc-html5.css"
	 , config_locale    = LocaleIn @'[EN] en_US
	 , config_generator = "https://hackage.haskell.org/package/hdoc"
	 }

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

-- * Type 'State'
data State
 =   State
 {   state_styles     :: Map FilePath TL.Text
 ,   state_scripts    :: Map FilePath TL.Text
 ,   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_l10n       :: Loqualization (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_l10n       = Loqualization EN_US
	 }

-- * 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 ()
	 BlockBreak{} -> 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) $$ do
					Loqualization loc <- liftStateMarkup $ S.gets state_l10n
					Plain.l10n_Table_of_Contents loc
			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
	 BlockBreak{..} ->
		html5CommonAttrs attrs
		 { classes = "page-break":"print-only":classes attrs } $
		H.div $$
			H.p $$ " " -- NOTE: force page break
	 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 (DTC.posAncestorsWithFigureNames pos)) $$ do
									html5ify type_
									html5ify $ DTC.posAncestorsWithFigureNames pos
						forM_ mayTitle $ \title -> do
							H.td ! HA.class_ "figure-colon" $$ do
								unless (TL.null type_) $ do
									Loqualization loc <- liftStateMarkup $ S.gets state_l10n
									Plain.l10n_Colon loc
							H.td ! HA.class_ "figure-title" $$ do
								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
	 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}}
	 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
		H.span ! HA.class_ "q" $$ do
			Loqualization loc <- liftStateMarkup $ S.gets state_l10n
			Plain.l10n_Quote (html5ify $ Tree PlainI ls) loc
	 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 s@Serie{id=id_, name} = do
		Loqualization loc <- liftStateMarkup $ S.gets state_l10n
		case urlSerie s of
		 Nothing -> do
			html5ify name
			Plain.l10n_Colon loc :: Html5
			html5ify id_
		 Just href -> do
			html5ify $
				Tree PlainEref{href} $
				Seq.fromList
				 [ tree0 $ PlainText $ name
				 , tree0 $ PlainText $ Plain.l10n_Colon loc
				 , tree0 $ PlainText id_
				 ]
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 date = do
		Loqualization loc <- liftStateMarkup $ S.gets state_l10n
		Plain.l10n_Date date loc
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

-- * 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
instance L10n Html5 EN where
	l10n_Header_Address _loc = "Address"
	l10n_Header_Date    _loc = "Date"
	l10n_Header_Origin  _loc = "Origin"
	l10n_Header_Source  _loc = "Source"
	l10n_Header_Version _loc = "Version"
instance L10n Html5 FR where
	l10n_Header_Address _loc = "Adresse"
	l10n_Header_Date    _loc = "Date"
	l10n_Header_Origin  _loc = "Origine"
	l10n_Header_Source  _loc = "Source"
	l10n_Header_Version _loc = "Version"

instance Plain.L10n Html5 EN where
	l10n_Colon             loc = html5ify (Plain.l10n_Colon loc :: TL.Text)
	l10n_Table_of_Contents loc = html5ify (Plain.l10n_Table_of_Contents loc :: TL.Text)
	l10n_Date date         loc = html5ify (Plain.l10n_Date date loc :: TL.Text)
	l10n_Quote msg _loc = 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             loc = html5ify (Plain.l10n_Colon loc :: TL.Text)
	l10n_Table_of_Contents loc = html5ify (Plain.l10n_Table_of_Contents loc :: TL.Text)
	l10n_Date date         loc = html5ify (Plain.l10n_Date date loc :: TL.Text)
	l10n_Quote msg _loc = 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}}