Language/DTC/Write/HTML5.hs

   1 {-# LANGUAGE DuplicateRecordFields #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE FlexibleContexts #-}
   4 {-# LANGUAGE MultiParamTypeClasses #-}
   5 {-# LANGUAGE OverloadedStrings #-}
   6 {-# LANGUAGE ScopedTypeVariables #-}
   7 {-# LANGUAGE TypeApplications #-}
   8 {-# LANGUAGE ViewPatterns #-}
   9 {-# OPTIONS_GHC -fno-warn-orphans #-}
  10 module Language.DTC.Write.HTML5 where
  11
  12 -- import Control.Monad.Trans.Class (MonadTrans(..))
  13 -- import Data.Functor.Identity (Identity(..))
  14 -- import Data.Sequence (Seq)
  15 -- import Data.Set (Set)
  16 -- import Data.Traversable (Traversable(..))
  17 -- import qualified Data.Sequence as Seq
  18 -- import qualified Data.TreeSeq.Strict as Tree
  19 import Control.Applicative (Applicative(..))
  20 import Control.Category
  21 import Control.Monad
  22 import Data.Bool
  23 import Data.Char (Char)
  24 import Data.Default.Class (Default(..))
  25 import Data.Foldable (Foldable(..), concat)
  26 import Data.Function (($), const, flip, on)
  27 import Data.Functor (Functor(..), (<$>))
  28 import Data.Functor.Compose (Compose(..))
  29 import Data.Int (Int)
  30 import Data.Map.Strict (Map)
  31 import Data.Maybe (Maybe(..), maybe, mapMaybe, fromJust, maybeToList)
  32 import Data.Monoid (Monoid(..))
  33 import Data.Ord (Ord(..))
  34 import Data.Semigroup (Semigroup(..))
  35 import Data.String (String)
  36 import Data.Text (Text)
  37 import Data.TreeSeq.Strict (Tree(..), Trees)
  38 import Data.Tuple (snd)
  39 import System.FilePath (FilePath)
  40 import Text.Blaze ((!))
  41 import Text.Blaze.Html (Html)
  42 import Text.Show (Show(..))
  43 import qualified Control.Monad.Trans.State as S
  44 import qualified Data.List as List
  45 import qualified Data.Map.Strict as Map
  46 import qualified Data.Sequence as Seq
  47 import qualified Data.Strict.Maybe as Strict
  48 import qualified Data.Text as Text
  49 import qualified Data.Text.Lazy as TL
  50 import qualified Data.TreeMap.Strict as TreeMap
  51 import qualified Data.TreeSeq.Strict as Tree
  52 import qualified Data.TreeSeq.Strict.Zipper as Tree
  53 import qualified Text.Blaze.Html5 as H
  54 import qualified Text.Blaze.Html5.Attributes  as HA
  55 import qualified Text.Blaze.Internal as H
  56
  57 import Text.Blaze.Utils
  58 import Data.Locale hiding (localize, Index)
  59 import qualified Data.Locale as Locale
  60
  61 import Language.DTC.Write.XML ()
  62 import Language.DTC.Write.Plain (Plain, Plainify(..))
  63 import qualified Language.DTC.Write.Plain as Plain
  64 import qualified Language.DTC.Document as DTC
  65 import qualified Language.DTC.Anchor as Anchor
  66
  67 (<&>) :: Functor f => f a -> (a -> b) -> f b
  68 (<&>) = flip (<$>)
  69 infixl 4 <&>
  70
  71 -- * Type 'Html5'
  72 type Html5 = StateMarkup State ()
  73
  74 -- ** Type 'State'
  75 data State
  76  =   State
  77  { state_styles     :: Map FilePath CSS
  78  , state_scripts    :: Map FilePath Script
  79  , state_indexs     :: Map DTC.Pos (DTC.Terms, Anchor.Irefs)
  80  , state_rrefs      :: Anchor.Rrefs
  81  , state_figures    :: Map Text (Map DTC.Pos DTC.Title)
  82  , state_references :: Map DTC.Ident DTC.About
  83  , state_plainify   :: Plain.State
  84  }
  85 instance Default State where
  86         def = State
  87          { state_styles     = mempty
  88          , state_scripts    = mempty
  89          , state_indexs     = mempty
  90          , state_rrefs      = mempty
  91          , state_figures    = mempty
  92          , state_references = mempty
  93          , state_plainify   = def
  94          }
  95 type CSS = Text
  96 type Script = Text
  97
  98 -- ** Type 'Keys'
  99 data Keys
 100  = Keys
 101  { keys_index     :: Map DTC.Pos DTC.Terms
 102  , keys_figure    :: Map Text (Map DTC.Pos DTC.Title)
 103  , keys_reference :: Map DTC.Ident DTC.About
 104  } deriving (Show)
 105
 106 keys :: Trees DTC.BodyKey DTC.BodyValue -> Keys
 107 keys body = foldl' flt (Keys mempty mempty mempty) (Compose body)
 108         where
 109         flt acc = \case
 110          DTC.Index{..} -> acc{keys_index =
 111                 Map.insert pos terms $ keys_index acc}
 112          DTC.Figure{..} -> acc{keys_figure =
 113                 Map.insertWith (<>)
 114                  type_ (Map.singleton pos title) $
 115                 keys_figure acc}
 116          DTC.References{..} -> acc{keys_reference =
 117                 foldr
 118                  (\r -> Map.insert
 119                          (DTC.id    (r::DTC.Reference))
 120                          (DTC.about (r::DTC.Reference)))
 121                  (keys_reference acc)
 122                  refs}
 123          _ -> acc
 124
 125 -- ** Class 'Html5ify'
 126 class Html5ify a where
 127         html5ify :: a -> Html5
 128 instance Html5ify Char where
 129         html5ify = html5ify . H.toMarkup
 130 instance Html5ify Text where
 131         html5ify = html5ify . H.toMarkup
 132 instance Html5ify TL.Text where
 133         html5ify = html5ify . H.toMarkup
 134 instance Html5ify String where
 135         html5ify = html5ify . H.toMarkup
 136 instance Html5ify H.Markup where
 137         html5ify = Compose . return
 138 instance Html5ify DTC.Title where
 139         html5ify (DTC.Title t) = html5ify t
 140 instance Html5ify DTC.Para where
 141         html5ify = mapM_ html5ify
 142 instance Html5ify DTC.Ident where
 143         html5ify (DTC.Ident i) = html5ify i
 144 instance Html5ify Int where
 145         html5ify = html5ify . show
 146 instance Html5ify DTC.Nat where
 147         html5ify (DTC.Nat n) = html5ify n
 148 instance Html5ify DTC.Nat1 where
 149         html5ify (DTC.Nat1 n) = html5ify n
 150
 151 html5Document ::
 152  Localize ls Plain Plain.L10n =>
 153  Locales ls =>
 154  LocaleIn ls -> DTC.Document -> Html
 155 html5Document locale DTC.Document{..} = do
 156         let Keys{..} = keys body
 157         let (body',state_rrefs,state_indexs) =
 158                 let irefs = foldMap Anchor.irefsOfTerms keys_index in
 159                 let (body0, Anchor.State{state_irefs, state_rrefs=rrefs}) =
 160                         Anchor.anchorify body `S.runState`
 161                         Anchor.state{Anchor.state_irefs=irefs} in
 162                 (body0,rrefs,) $
 163                 (<$> keys_index) $ \terms ->
 164                         (terms,) $
 165                         TreeMap.intersection const state_irefs $
 166                         Anchor.irefsOfTerms terms
 167         let state_plainify = def
 168                 { Plain.state_localize = Locale.localize locale }
 169         let (html5Body, State{state_styles,state_scripts}) =
 170                 runStateMarkup def
 171                  { state_indexs
 172                  , state_rrefs
 173                  , state_figures    = keys_figure
 174                  , state_references = keys_reference
 175                  , state_plainify
 176                  } $ html5ify body'
 177
 178         H.docType
 179         H.html ! HA.lang (attrify $ countryCode locale) $ do
 180                 H.head $ do
 181                         H.meta ! HA.httpEquiv "Content-Type"
 182                                ! HA.content "text/html; charset=UTF-8"
 183                         whenSome (DTC.titles $ DTC.about (head :: DTC.Head)) $ \ts ->
 184                                 H.title $
 185                                         H.toMarkup $ Plain.text state_plainify $ List.head ts
 186                         forM_ (DTC.links $ DTC.about (head :: DTC.Head)) $ \DTC.Link{rel, href} ->
 187                                 H.link ! HA.rel (attrify rel)
 188                                        ! HA.href (attrify href)
 189                         H.meta ! HA.name "generator"
 190                                ! HA.content "tct"
 191                         let chapters =
 192                                 (`mapMaybe` toList body) $ \case
 193                                  TreeN k@DTC.Section{} _ -> Just k
 194                                  _ -> Nothing
 195                         forM_ chapters $ \DTC.Section{..} ->
 196                                 H.link ! HA.rel "Chapter"
 197                                        ! HA.title (attrify $ plainify title)
 198                                        ! HA.href ("#"<>attrify pos)
 199                         H.link ! HA.rel "stylesheet"
 200                                ! HA.type_ "text/css"
 201                                ! HA.href "style/dtc-html5.css"
 202                         forM_ state_styles $ \style ->
 203                                 H.style ! HA.type_ "text/css" $
 204                                         H.toMarkup style
 205                         forM_ state_scripts $ \script ->
 206                                 H.script ! HA.type_ "application/javascript" $
 207                                         H.toMarkup script
 208                 H.body
 209                         html5Body
 210
 211 -- * Type 'BodyCursor'
 212 -- | Cursor to navigate within a 'DTC.Body' according to many axis (like in XSLT).
 213 type BodyCursor = Tree.Zipper DTC.BodyKey DTC.BodyValue
 214 instance Html5ify DTC.Body where
 215         html5ify body =
 216                 forM_ (Tree.zippers body) $ \z ->
 217                         forM_ (Tree.axis_repeat Tree.axis_following_sibling_nearest `Tree.runAxis` z) $
 218                                 html5ify
 219
 220 instance Html5ify BodyCursor where
 221         html5ify z =
 222                 case Tree.current z of
 223                  TreeN k _ts -> html5BodyKey z k
 224                  Tree0 v     -> html5BodyValue z v
 225
 226 html5BodyKey :: BodyCursor -> DTC.BodyKey -> Html5
 227 html5BodyKey z = \case
 228          DTC.Section{..} ->
 229                 H.section ! HA.class_ "section"
 230                           ! HA.id (attrify pos) $$ do
 231                         html5CommonAttrs attrs $
 232                                 H.table ! HA.class_ "section-header" $$
 233                                         H.tbody $$
 234                                                 H.tr $$ do
 235                                                         H.td ! HA.class_ "section-number" $$ do
 236                                                                 html5SectionNumber $ DTC.posAncestors pos
 237                                                         H.td ! HA.class_ "section-title" $$ do
 238                                                                 (case List.length $ DTC.posAncestors pos of
 239                                                                  0 -> H.h1
 240                                                                  1 -> H.h2
 241                                                                  2 -> H.h3
 242                                                                  3 -> H.h4
 243                                                                  4 -> H.h5
 244                                                                  5 -> H.h6
 245                                                                  _ -> H.h6) $$
 246                                                                         html5ify title
 247                         forM_ (Tree.axis_child `Tree.runAxis` z) $
 248                                 html5ify
 249 html5BodyValue :: BodyCursor -> DTC.BodyValue -> Html5
 250 html5BodyValue z = \case
 251          DTC.Block b -> html5ify b
 252          DTC.ToC{..} -> do
 253                 H.nav ! HA.class_ "toc"
 254                       ! HA.id (attrify pos) $$ do
 255                         H.span ! HA.class_ "toc-name" $$
 256                                 H.a ! HA.href (attrify pos) $$
 257                                         html5ify Plain.L10n_Table_of_Contents
 258                         H.ul $$
 259                                 forM_ (Tree.axis_following_sibling `Tree.runAxis` z) $
 260                                         html5ifyToC depth
 261          DTC.ToF{..} -> do
 262                 H.nav ! HA.class_ "tof"
 263                       ! HA.id (attrify pos) $$
 264                         H.table ! HA.class_ "tof" $$
 265                                 H.tbody $$
 266                                         html5ifyToF types
 267          DTC.Figure{..} ->
 268                 html5CommonAttrs attrs $
 269                 H.div ! HA.class_ ("figure " <> attrify ("figure-"<>type_))
 270                       ! HA.id (attrify pos) $$ do
 271                         H.table ! HA.class_ "figure-caption" $$
 272                                 H.tbody $$
 273                                         H.tr $$ do
 274                                                 H.td ! HA.class_ "figure-number" $$ do
 275                                                         H.a ! HA.href ("#"<>attrify pos) $$ do
 276                                                                 html5ify type_
 277                                                                 html5ify $ DTC.posAncestors pos
 278                                                         html5ify $ Plain.L10n_Colon
 279                                                         " "
 280                                                 H.td ! HA.class_ "figure-name" $$
 281                                                         html5ify title
 282                         H.div ! HA.class_ "figure-content" $$ do
 283                                 html5ify blocks
 284          DTC.Index{pos} -> do
 285                 (allTerms,refsByTerm) <- liftStateMarkup $ S.gets $ (Map.! pos) . state_indexs
 286                 let chars = Anchor.termsByChar allTerms
 287                 H.div ! HA.class_ "index"
 288                       ! HA.id (attrify pos) $$ do
 289                         H.nav ! HA.class_ "index-nav" $$ do
 290                                 forM_ (Map.keys chars) $ \char ->
 291                                         H.a ! HA.href ("#"<>(attrify pos <> "." <> attrify char)) $$
 292                                                 html5ify char
 293                         H.dl ! HA.class_ "index-chars" $$
 294                                 forM_ (Map.toList chars) $ \(char,terms) -> do
 295                                         H.dt $$
 296                                                 let i = attrify pos <> "." <> attrify char in
 297                                                 H.a ! HA.id i
 298                                                     ! HA.href ("#"<>i) $$
 299                                                         html5ify char
 300                                         H.dd $$
 301                                                 H.dl ! HA.class_ "index-term" $$ do
 302                                                 forM_ terms $ \aliases -> do
 303                                                         H.dt $$
 304                                                                 H.ul ! HA.class_ "index-aliases" $$
 305                                                                         forM_ (List.take 1 aliases) $ \term ->
 306                                                                                 H.li ! HA.id (attrify term) $$
 307                                                                                         html5ify term
 308                                                         H.dd $$
 309                                                                 let anchs =
 310                                                                         List.sortBy (compare `on` DTC.section . snd) $
 311                                                                         (`foldMap` aliases) $ \words ->
 312                                                                                 fromJust $ do
 313                                                                                         path <- Anchor.pathFromWords words
 314                                                                                         Strict.maybe Nothing (Just . ((words,) <$>) . List.reverse) $
 315                                                                                                 TreeMap.lookup path refsByTerm in
 316                                                                 html5CommasDot $
 317                                                                 (<$> anchs) $ \(term,DTC.Anchor{..}) ->
 318                                                                         H.a ! HA.class_ "index-iref"
 319                                                                             ! HA.href ("#"<>attrify (term,count)) $$
 320                                                                                 html5ify $ DTC.posAncestors section
 321          DTC.References{..} ->
 322                 html5CommonAttrs attrs $
 323                 H.div ! HA.class_ "references"
 324                       ! HA.id (attrify pos) $$ do
 325                         H.table $$
 326                                 forM_ refs html5ify
 327
 328 instance Html5ify DTC.Words where
 329         html5ify = html5ify . Anchor.plainifyWords
 330
 331 cleanPara :: DTC.Para -> DTC.Para
 332 cleanPara p =
 333         p >>= (`Tree.bindTrees` \case
 334          TreeN DTC.Iref{} ls -> ls
 335          TreeN DTC.Note{} _  -> mempty
 336          h -> pure h)
 337
 338 html5ifyToC :: Maybe DTC.Nat -> BodyCursor -> Html5
 339 html5ifyToC depth z =
 340         case Tree.current z of
 341          TreeN DTC.Section{..} _ts -> do
 342                 H.li $$ do
 343                         H.table ! HA.class_ "toc-entry" $$
 344                                 H.tbody $$
 345                                         H.tr $$ do
 346                                                 H.td ! HA.class_ "section-number" $$
 347                                                         html5SectionRef $ DTC.posAncestors pos
 348                                                 H.td ! HA.class_ "section-title" $$
 349                                                         html5ify $ cleanPara $ DTC.unTitle title
 350                         when (maybe True (> DTC.Nat 1) depth && not (null sections)) $
 351                                 H.ul $$
 352                                         forM_ sections $
 353                                                 html5ifyToC (depth >>= DTC.predNat)
 354          _ -> pure ()
 355         where
 356         sections =
 357                 (`Tree.runAxis` z) $
 358                 Tree.axis_child
 359                 `Tree.axis_filter_current` \case
 360                  TreeN DTC.Section{} _ -> True
 361                  _ -> False
 362
 363 html5ifyToF :: [Text] -> Html5
 364 html5ifyToF types = do
 365         figsByType <- liftStateMarkup $ S.gets state_figures
 366         let figs =
 367                 Map.foldMapWithKey (\ty -> ((ty,) <$>)) $
 368                 if null types
 369                 then figsByType
 370                 else
 371                         Map.intersection figsByType $
 372                         Map.fromList [(ty,()) | ty <- types]
 373         forM_ (Map.toList figs) $ \(pos, (type_, title)) ->
 374                 H.tr $$ do
 375                         H.td ! HA.class_ "figure-number" $$
 376                                 H.a ! HA.href ("#"<>attrify pos) $$ do
 377                                         html5ify type_
 378                                         html5ify $ DTC.posAncestors pos
 379                         H.td ! HA.class_ "figure-name" $$
 380                                 html5ify $ cleanPara $ DTC.unTitle title
 381
 382 instance Html5ify [DTC.Block] where
 383         html5ify = mapM_ html5ify
 384 instance Html5ify DTC.Block where
 385         html5ify = \case
 386          DTC.Para{..} ->
 387                 html5CommonAttrs attrs $
 388                 H.p ! HA.class_ "para"
 389                     ! HA.id (attrify pos) $$ do
 390                         html5ify para
 391          DTC.OL{..} ->
 392                 html5CommonAttrs attrs $
 393                 H.ol ! HA.class_ "ol"
 394                      ! HA.id (attrify pos) $$ do
 395                         forM_ items $ \item ->
 396                                 H.li $$ html5ify item
 397          DTC.UL{..} ->
 398                 html5CommonAttrs attrs $
 399                 H.ul ! HA.class_ "ul"
 400                      ! HA.id (attrify pos) $$ do
 401                         forM_ items $ \item ->
 402                                 H.li $$ html5ify item
 403          DTC.Comment t ->
 404                 html5ify $ H.Comment (H.Text t) ()
 405 instance Html5ify DTC.Lines where
 406         html5ify = \case
 407          Tree0 v ->
 408                 case v of
 409                  DTC.BR      -> html5ify H.br
 410                  DTC.Plain t -> html5ify t
 411          TreeN k ls ->
 412                 case k of
 413                  DTC.B    -> H.strong $$ html5ify ls
 414                  DTC.Code -> H.code   $$ html5ify ls
 415                  DTC.Del  -> H.del    $$ html5ify ls
 416                  DTC.I    -> do
 417                         i <- liftStateMarkup $ do
 418                                 i <- S.gets $ Plain.state_italic . state_plainify
 419                                 S.modify $ \s ->
 420                                         s{state_plainify=
 421                                                 (state_plainify s){Plain.state_italic=
 422                                                         not i}}
 423                                 return i
 424                         H.em ! HA.class_ (if i then "even" else "odd") $$
 425                                 html5ify ls
 426                         liftStateMarkup $
 427                                 S.modify $ \s ->
 428                                         s{state_plainify=
 429                                                 (state_plainify s){Plain.state_italic=i}}
 430                  DTC.Sub  -> H.sub    $$ html5ify ls
 431                  DTC.Sup  -> H.sup    $$ html5ify ls
 432                  DTC.SC   -> H.span ! HA.class_ "smallcaps" $$ html5ify ls
 433                  DTC.U    -> H.span ! HA.class_ "underline" $$ html5ify ls
 434                  DTC.Note -> ""
 435                  DTC.Q -> do
 436                         d <- liftStateMarkup $ do
 437                                 d <- S.gets $ Plain.state_quote . state_plainify
 438                                 S.modify $ \s -> s{state_plainify=
 439                                         (state_plainify s){Plain.state_quote=
 440                                                 DTC.succNat d}}
 441                                 return d
 442                         H.span ! HA.class_ "q" $$ do
 443                                 html5ify $ Plain.L10n_QuoteOpen d
 444                                 html5ify $ TreeN DTC.I ls
 445                                 html5ify $ Plain.L10n_QuoteClose d
 446                         liftStateMarkup $
 447                                 S.modify $ \s ->
 448                                         s{state_plainify=
 449                                                 (state_plainify s){Plain.state_quote = d}}
 450                  DTC.Eref{..} ->
 451                         H.a ! HA.class_ "eref"
 452                             ! HA.href (attrify href) $$
 453                                 if null ls
 454                                 then html5ify $ DTC.unURL href
 455                                 else html5ify ls
 456                  DTC.Iref{..} ->
 457                         case anchor of
 458                          Nothing -> html5ify ls
 459                          Just DTC.Anchor{..} ->
 460                                 H.span ! HA.class_ "iref"
 461                                        ! HA.id (attrify (term,count)) $$
 462                                         html5ify ls
 463                  DTC.Ref{..} ->
 464                         H.a ! HA.class_ "ref"
 465                             ! HA.href ("#"<>attrify to) $$
 466                         if null ls
 467                         then html5ify to
 468                         else html5ify ls
 469                  DTC.Rref{..} -> do
 470                         refs <- liftStateMarkup $ S.gets state_references
 471                         case Map.lookup to refs of
 472                          Nothing -> do
 473                                 "["::Html5
 474                                 H.span ! HA.class_ "rref-broken" $$
 475                                         html5ify to
 476                                 "]"
 477                          Just DTC.About{..} -> do
 478                                 when (not $ null ls) $
 479                                         forM_ (List.take 1 titles) $ \(DTC.Title title) -> do
 480                                                 html5ify $ TreeN DTC.Q $
 481                                                         case url of
 482                                                          Nothing -> title
 483                                                          Just u -> pure $ TreeN (DTC.Eref u) title
 484                                                 " "::Html5
 485                                 "["::Html5
 486                                 H.a ! HA.class_ "rref"
 487                                     ! HA.href ("#rref."<>attrify to)
 488                                     ! HA.id ("rref."<>attrify to<>maybe "" (\DTC.Anchor{..} -> "."<>attrify count) anchor) $$
 489                                         html5ify to
 490                                 "]"
 491 instance Html5ify DTC.URL where
 492         html5ify (DTC.URL url) =
 493                 H.a ! HA.class_ "eref"
 494                     ! HA.href (attrify url) $$
 495                         html5ify url
 496
 497 instance Attrify DTC.Words where
 498         attrify term =
 499                 "iref" <> "." <> attrify (Anchor.plainifyWords term)
 500 instance Attrify (DTC.Words,DTC.Nat1) where
 501         attrify (term,count) =
 502                 "iref"
 503                  <> "." <> attrify (Anchor.plainifyWords term)
 504                  <> "." <> attrify count
 505 instance Html5ify DTC.Date where
 506         html5ify = html5ify . Plain.L10n_Date
 507 instance Html5ify DTC.About where
 508         html5ify DTC.About{..} =
 509                 html5CommasDot $ concat $
 510                  [ (<$> List.take 1 titles) $ \(DTC.Title title) ->
 511                         html5ify $ TreeN DTC.Q $
 512                                 case url of
 513                                  Nothing -> title
 514                                  Just u -> pure $ TreeN (DTC.Eref u) title
 515                  , html5Entity <$> authors
 516                  , html5ify <$> maybeToList date
 517                  , html5Entity <$> maybeToList editor
 518                  , html5Serie <$> series
 519                  ]
 520                 where
 521                 html5Serie DTC.Serie{..} = do
 522                         html5ify key
 523                         html5ify Plain.L10n_Colon
 524                         html5ify name
 525                 html5Entity DTC.Entity{url=mu, ..} =
 526                         html5ify @DTC.Lines $
 527                         case () of
 528                          _ | not (Text.null email) ->
 529                                 TreeN (DTC.Eref $ DTC.URL $ "mailto:"<>email) $
 530                                         pure $ Tree0 $ DTC.Plain name
 531                          _ | Just u <- mu  ->
 532                                 TreeN (DTC.Eref u) $
 533                                         pure $ Tree0 $ DTC.Plain name
 534                          _ -> Tree0 $ DTC.Plain name
 535 instance Html5ify DTC.Reference where
 536         html5ify DTC.Reference{id=id_, ..} =
 537                 H.tr $$ do
 538                         H.td ! HA.class_ "reference-key" $$
 539                                 html5ify @DTC.Lines $ TreeN DTC.Rref{anchor=Nothing, to=id_} Seq.empty
 540                         H.td ! HA.class_ "reference-content" $$ do
 541                                 html5ify about
 542                                 rrefs <- liftStateMarkup $ S.gets state_rrefs
 543                                 case Map.lookup id_ rrefs of
 544                                  Nothing -> pure ()
 545                                  Just anchs ->
 546                                         H.span ! HA.class_ "reference-rrefs" $$
 547                                                 html5CommasDot $
 548                                                 (<$> List.reverse anchs) $ \DTC.Anchor{..} ->
 549                                                         H.a ! HA.class_ "reference-rref"
 550                                                             ! HA.href ("#rref."<>attrify id_<>"."<>attrify count) $$
 551                                                                 html5ify $ DTC.posAncestors section
 552
 553 html5CommasDot :: [Html5] -> Html5
 554 html5CommasDot [] = pure ()
 555 html5CommasDot hs = do
 556         sequence_ $ List.intersperse ", " hs
 557         "."
 558
 559 html5CommonAttrs :: DTC.CommonAttrs -> Html5 -> Html5
 560 html5CommonAttrs DTC.CommonAttrs{id=id_, ..} =
 561         Compose . (addClass . addId <$>) . getCompose
 562         where
 563         addClass =
 564                 case classes of
 565                  [] -> id
 566                  _  -> H.AddCustomAttribute "class" (H.Text $ Text.unwords classes)
 567         addId = maybe id (\(DTC.Ident i) ->
 568                 H.AddCustomAttribute "id" (H.Text i)) id_
 569
 570 html5SectionNumber :: DTC.PosPath -> Html5
 571 html5SectionNumber = go mempty
 572         where
 573         go :: DTC.PosPath -> DTC.PosPath -> Html5
 574         go prev next =
 575                 case Seq.viewl next of
 576                  Seq.EmptyL -> pure ()
 577                  a@(_n,rank) Seq.:< as -> do
 578                         H.a ! HA.href ("#"<>attrify (prev Seq.|>a)) $$
 579                                 html5ify $ show rank
 580                         when (not (null as) || null prev) $ do
 581                                 html5ify '.'
 582                                 go (prev Seq.|>a) as
 583
 584 html5SectionRef :: DTC.PosPath -> Html5
 585 html5SectionRef as =
 586         H.a ! HA.href ("#"<>attrify as) $$
 587                 html5ify as
 588
 589 instance Html5ify DTC.PosPath where
 590         html5ify ancs =
 591                 case toList ancs of
 592                  [(_n,c)] -> do
 593                         html5ify $ show c
 594                         html5ify '.'
 595                  as ->
 596                         html5ify $
 597                                 Text.intercalate "." $
 598                                 Text.pack . show . snd <$> as
 599 instance Html5ify Plain where
 600         html5ify p = do
 601                 sp <- liftStateMarkup $ S.gets state_plainify
 602                 let (t,sp') = Plain.runPlain p sp
 603                 html5ify t
 604                 liftStateMarkup $ S.modify $ \s -> s{state_plainify=sp'}
 605 instance Attrify Plain where
 606         attrify p =
 607                 let (t,_) = Plain.runPlain p def in
 608                 attrify t
 609
 610 instance Attrify DTC.PosPath where
 611         attrify = attrify . plainify
 612 instance Attrify DTC.Pos where
 613         attrify = attrify . DTC.posAncestors
 614
 615 -- * Type 'L10n'
 616 instance Html5ify Plain.L10n where
 617         html5ify = html5ify . plainify
 618 instance Localize ls Plain Plain.L10n => Localize ls Html5 Plain.L10n where
 619         localize loc a = html5ify (Locale.localize loc a::Plain)
 620 instance LocalizeIn FR Html5 Plain.L10n where
 621         localizeIn loc = html5ify @Plain . localizeIn loc
 622 instance LocalizeIn EN Html5 Plain.L10n where
 623         localizeIn loc = html5ify @Plain . localizeIn loc