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

-- import Control.Monad.Trans.Class (MonadTrans(..))
-- import Data.Functor.Identity (Identity(..))
-- import Data.Sequence (Seq)
-- import Data.Set (Set)
-- import Data.Traversable (Traversable(..))
-- import qualified Data.Sequence as Seq
-- import qualified Data.TreeSeq.Strict as Tree
import Control.Applicative (Applicative(..))
import Control.Category
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)
import Data.Text (Text)
import Data.TreeSeq.Strict (Tree(..), Trees)
import Data.Tuple (snd)
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 as Tree
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 (localize, Index)
import qualified Data.Locale as Locale

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

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

-- * Type 'Html5'
type Html5 = StateMarkup State ()

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

-- * Type 'Keys'
data Keys
 = Keys
 { keys_index     :: Map DTC.Pos DTC.Terms
 , keys_figure    :: Map Text (Map DTC.Pos (Maybe DTC.Title))
 , keys_reference :: Map DTC.Ident DTC.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 (Trees DTC.BodyKey DTC.BodyValue) where
	keys = mapM_ keys
instance KeysOf (Tree DTC.BodyKey DTC.BodyValue) where
	keys = \case
	 TreeN k ts ->
		case k of
		 DTC.Section{..} ->
			keys ts
	 Tree0 v ->
		case v of
		 DTC.Index{..} ->
			S.modify $ \s -> s{keys_index=
				Map.insert pos terms $ keys_index s}
		 DTC.Figure{..} ->
			S.modify $ \s -> s{keys_figure=
				Map.insertWith (<>)
				 type_ (Map.singleton pos title) $
				keys_figure s}
		 DTC.References{..} ->
			S.modify $ \s -> s{keys_reference=
				foldr
				 (\r -> Map.insert
					 (DTC.id    (r::DTC.Reference))
					 (DTC.about (r::DTC.Reference)))
				 (keys_reference s)
				 refs}
		 DTC.ToC{} -> return ()
		 DTC.ToF{} -> return ()
		 DTC.Block{} -> return ()

-- * Class 'Html5ify'
class Html5ify a where
	html5ify :: a -> Html5
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 H.Markup where
	html5ify = Compose . return
instance Html5ify DTC.Title where
	html5ify (DTC.Title t) = html5ify t
instance Html5ify DTC.Para where
	html5ify = mapM_ html5ify
instance Html5ify DTC.Ident where
	html5ify (DTC.Ident i) = html5ify i
instance Html5ify Int where
	html5ify = html5ify . show
instance Html5ify DTC.Nat where
	html5ify (DTC.Nat n) = html5ify n
instance Html5ify DTC.Nat1 where
	html5ify (DTC.Nat1 n) = html5ify n

html5Document ::
 Localize ls Plain Plain.L10n =>
 Locales ls =>
 LocaleIn ls -> DTC.Document -> Html
html5Document locale 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_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
		 } $ 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"
			whenSome (DTC.titles $ DTC.about (head :: DTC.Head)) $ \ts ->
				H.title $
					H.toMarkup $ Plain.text state_plainify $ List.head ts
			forM_ (DTC.links $ DTC.about (head :: DTC.Head)) $ \DTC.Link{rel, href} ->
				H.link ! HA.rel (attrify rel)
				       ! HA.href (attrify href)
			H.meta ! HA.name "generator"
			       ! HA.content "tct"
			let chapters =
				(`mapMaybe` toList body) $ \case
				 TreeN k@DTC.Section{} _ -> Just k
				 _ -> Nothing
			forM_ chapters $ \DTC.Section{..} ->
				H.link ! HA.rel "Chapter"
				       ! HA.title (attrify $ plainify title)
				       ! HA.href ("#"<>attrify pos)
			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

-- * Type 'BodyCursor'
-- | Cursor to navigate within a 'DTC.Body' according to many axis (like in XSLT).
type BodyCursor = Tree.Zipper DTC.BodyKey DTC.BodyValue
instance Html5ify DTC.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 =
	case Tree.current z of
	 TreeN k _ts ->
		case k of
		 DTC.Section{..} ->
			H.section ! HA.class_ "section"
			          ! HA.id (attrify pos) $$ do
				html5CommonAttrs attrs $
					H.table ! HA.class_ "section-header" $$
						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
				case Map.lookup pos notes of
				 Nothing -> return ()
				 Just ns ->
					H.aside ! HA.class_ "notes" $$ do
						Compose $ pure H.hr
						H.table $$
							H.tbody $$
								forM_ ns $ \(num,para) ->
									H.tr $$ do
										H.td ! HA.class_ "note-ref" $$ do
											H.a ! HA.class_ "note-number"
											    ! HA.id   ("note."<>attrify num)
											    ! HA.href ("#note."<>attrify num) $$ do
												html5ify num
											". "::Html5
											H.a ! HA.href ("#note-ref."<>attrify num) $$ do
												"↑"
										H.td $$
											html5ify para
	 Tree0 v ->
		case v of
		 DTC.Block b -> html5ify b
		 DTC.ToC{..} -> 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
		 DTC.ToF{..} -> do
			H.nav ! HA.class_ "tof"
			      ! HA.id (attrify pos) $$
				H.table ! HA.class_ "tof" $$
					H.tbody $$
						html5ifyToF types
		 DTC.Figure{..} ->
			html5CommonAttrs attrs $
			H.div ! HA.class_ ("figure " <> attrify ("figure-"<>type_))
			      ! HA.id (attrify pos) $$ do
				H.table ! HA.class_ "figure-caption" $$
					H.tbody $$
						H.tr $$ do
							H.td ! HA.class_ "figure-number" $$ do
								H.a ! HA.href ("#"<>attrify pos) $$ do
									html5ify type_
									html5ify $ DTC.posAncestors pos
							forM_ title $ \ti -> do
								html5ify $ Plain.L10n_Colon
								H.td ! HA.class_ "figure-title" $$
									html5ify ti
				H.div ! HA.class_ "figure-content" $$ do
					html5ify blocks
		 DTC.Index{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
		 DTC.References{..} ->
			html5CommonAttrs attrs $
			H.div ! HA.class_ "references"
			      ! HA.id (attrify pos) $$ do
				H.table $$
					forM_ refs html5ify
instance Html5ify DTC.Words where
	html5ify = html5ify . Anchor.plainifyWords

cleanPara :: DTC.Para -> DTC.Para
cleanPara p =
	p >>= (`Tree.bindTrees` \case
	 TreeN DTC.Iref{} ls -> ls
	 TreeN DTC.Note{} _  -> mempty
	 h -> pure h)

html5ifyToC :: Maybe DTC.Nat -> BodyCursor -> Html5
html5ifyToC depth z =
	case Tree.current z of
	 TreeN DTC.Section{..} _ts -> 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 $ cleanPara $ DTC.unTitle title
			when (maybe True (> DTC.Nat 1) depth && not (null sections)) $
				H.ul $$
					forM_ sections $
						html5ifyToC (depth >>= DTC.predNat)
	 _ -> pure ()
	where
	sections =
		(`Tree.runAxis` z) $
		Tree.axis_child
		`Tree.axis_filter_current` \case
		 TreeN DTC.Section{} _ -> True
		 _ -> False

html5ifyToF :: [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 $ cleanPara $ DTC.unTitle ti

instance Html5ify [DTC.Block] where
	html5ify = mapM_ html5ify
instance Html5ify DTC.Block where
	html5ify = \case
	 DTC.Para{..} ->
		html5CommonAttrs attrs $
		H.p ! HA.class_ "para"
		    ! HA.id (attrify pos) $$ do
			html5ify para
	 DTC.OL{..} ->
		html5CommonAttrs attrs $
		H.ol ! HA.class_ "ol"
		     ! HA.id (attrify pos) $$ do
			forM_ items $ \item ->
				H.li $$ html5ify item
	 DTC.UL{..} ->
		html5CommonAttrs attrs $
		H.ul ! HA.class_ "ul"
		     ! HA.id (attrify pos) $$ do
			forM_ items $ \item ->
				H.li $$ html5ify item
	 DTC.Comment t ->
		html5ify $ H.Comment (H.Text t) ()
instance Html5ify DTC.Lines where
	html5ify = \case
	 Tree0 v ->
		case v of
		 DTC.BR      -> html5ify H.br
		 DTC.Plain t -> html5ify t
	 TreeN k ls ->
		case k of
		 DTC.B    -> H.strong $$ html5ify ls
		 DTC.Code -> H.code   $$ html5ify ls
		 DTC.Del  -> H.del    $$ html5ify ls
		 DTC.I    -> 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}}
		 DTC.Sub  -> H.sub    $$ html5ify ls
		 DTC.Sup  -> H.sup    $$ html5ify ls
		 DTC.SC   -> H.span ! HA.class_ "smallcaps" $$ html5ify ls
		 DTC.U    -> H.span ! HA.class_ "underline" $$ html5ify ls
		 DTC.Note{..} ->
			case number of
			 Nothing -> ""
			 Just num ->
				H.sup ! HA.class_ "note-number" $$
					H.a ! HA.class_ "note-ref"
					    ! HA.id ("note-ref."<>attrify num)
					    ! HA.href ("#note."<>attrify num) $$
						html5ify num
		 DTC.Q -> do
			depth <- liftStateMarkup $ do
				depth <- S.gets $ Plain.state_quote . state_plainify
				S.modify $ \s -> s{state_plainify=
					(state_plainify s){Plain.state_quote=
						DTC.succNat depth}}
				return depth
			H.span ! HA.class_ "q" $$ do
				html5ify $ Plain.L10n_QuoteOpen depth
				html5ify $ TreeN DTC.I ls
				html5ify $ Plain.L10n_QuoteClose depth
			liftStateMarkup $
				S.modify $ \s ->
					s{state_plainify=
						(state_plainify s){Plain.state_quote = depth}}
		 DTC.Eref{..} ->
			H.a ! HA.class_ "eref"
			    ! HA.href (attrify href) $$
				if null ls
				then html5ify $ DTC.unURL href
				else html5ify ls
		 DTC.Iref{..} ->
			case anchor of
			 Nothing -> html5ify ls
			 Just DTC.Anchor{..} ->
				H.span ! HA.class_ "iref"
				       ! HA.id (attrifyIrefCount term count) $$
					html5ify ls
		 DTC.Ref{..} ->
			H.a ! HA.class_ "ref"
			    ! HA.href ("#"<>attrify to) $$
			if null ls
			then html5ify to
			else html5ify ls
		 DTC.Rref{..} -> 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 DTC.About{..} -> do
				when (not $ null ls) $
					forM_ (List.take 1 titles) $ \(DTC.Title title) -> do
						html5ify $ TreeN DTC.Q $
							case url of
							 Nothing -> title
							 Just u -> pure $ TreeN (DTC.Eref u) title
						" "::Html5
				"["::Html5
				H.a ! HA.class_ "rref"
				    ! HA.href ("#rref."<>attrify to)
				    ! HA.id ("rref."<>attrify to<>maybe "" (\DTC.Anchor{..} -> "."<>attrify count) anchor) $$
					html5ify to
				"]"
instance Html5ify DTC.URL where
	html5ify (DTC.URL url) =
		H.a ! HA.class_ "eref"
		    ! HA.href (attrify url) $$
			html5ify url
instance Html5ify DTC.Date where
	html5ify = html5ify . Plain.L10n_Date
instance Html5ify DTC.About where
	html5ify DTC.About{..} =
		html5CommasDot $ concat $
		 [ html5Titles titles
		 , html5Entity <$> authors
		 , html5ify    <$> maybeToList date
		 , html5Entity <$> maybeToList editor
		 , html5Serie  <$> series
		 ]
		where
		html5Titles :: [DTC.Title] -> [Html5]
		html5Titles ts | null ts = []
		html5Titles ts = [html5Title $ fold $ List.intersperse t $ toList ts]
			where t = DTC.Title $ Seq.singleton $ Tree0 $ DTC.Plain " — "
		html5Title (DTC.Title title) =
			html5ify $ TreeN DTC.Q $
				case url of
				 Nothing -> title
				 Just u -> pure $ TreeN (DTC.Eref u) title
		html5SerieHref href DTC.Serie{..} = do
			sp <- liftStateMarkup $ S.gets state_plainify
			html5ify $
				TreeN DTC.Eref{href} $
				Seq.fromList
				 [ Tree0 $ DTC.Plain $ name
				 , Tree0 $ DTC.Plain $ TL.toStrict $ Plain.text sp Plain.L10n_Colon
				 , Tree0 $ DTC.Plain key
				 ]
		html5Serie s@DTC.Serie{name="RFC", key} | Text.all Char.isDigit key =
			html5SerieHref (DTC.URL $ "https://tools.ietf.org/html/rfc"<>key) s
		html5Serie s@DTC.Serie{name="DOI", key} =
			html5SerieHref (DTC.URL $ "https://dx.doi.org/"<>key) s
		html5Serie DTC.Serie{..} = do
			html5ify name
			html5ify Plain.L10n_Colon
			html5ify key
		html5Entity DTC.Entity{url=mu, ..} = do
			html5ify @DTC.Lines $
				case () of
				 _ | not (Text.null email) ->
					TreeN (DTC.Eref $ DTC.URL $ "mailto:"<>email) $
						pure $ Tree0 $ DTC.Plain name
				 _ | Just u <- mu  ->
					TreeN (DTC.Eref u) $
						pure $ Tree0 $ DTC.Plain name
				 _ -> Tree0 $ DTC.Plain name
			forM_ org $ \o -> do
				" ("::Html5
				html5Entity o
				")"::Html5
instance Html5ify DTC.Reference where
	html5ify DTC.Reference{id=id_, ..} =
		H.tr $$ do
			H.td ! HA.class_ "reference-key" $$
				html5ify @DTC.Lines $ TreeN DTC.Rref{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) $ \DTC.Anchor{..} ->
							H.a ! HA.class_ "reference-rref"
							    ! HA.href ("#rref."<>attrify id_<>"."<>attrify count) $$
								html5ify $ DTC.posAncestors section
instance Html5ify DTC.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 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
	"."

html5CommonAttrs :: DTC.CommonAttrs -> Html5 -> Html5
html5CommonAttrs DTC.CommonAttrs{id=id_, ..} =
	Compose . (addClass . addId <$>) . getCompose
	where
	addClass =
		case classes of
		 [] -> id
		 _  -> H.AddCustomAttribute "class" (H.Text $ Text.unwords classes)
	addId = maybe id (\(DTC.Ident i) ->
		H.AddCustomAttribute "id" (H.Text i)) id_

html5SectionNumber :: DTC.PosPath -> Html5
html5SectionNumber = go mempty
	where
	go :: DTC.PosPath -> DTC.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 :: DTC.PosPath -> Html5
html5SectionRef as =
	H.a ! HA.href ("#"<>attrify as) $$
		html5ify as


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

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

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