Hdoc/DTC/Write/HTML5.hs

   1 {-# LANGUAGE DataKinds #-}
   2 {-# LANGUAGE DuplicateRecordFields #-}
   3 {-# LANGUAGE ExistentialQuantification #-}
   4 {-# LANGUAGE FlexibleInstances #-}
   5 {-# LANGUAGE FlexibleContexts #-}
   6 {-# LANGUAGE MultiParamTypeClasses #-}
   7 {-# LANGUAGE OverloadedStrings #-}
   8 {-# LANGUAGE ScopedTypeVariables #-}
   9 {-# OPTIONS_GHC -fno-warn-orphans #-}
  10 module Hdoc.DTC.Write.HTML5
  11  ( module Hdoc.DTC.Write.HTML5
  12  , module Hdoc.DTC.Write.HTML5.Ident
  13  , module Hdoc.DTC.Write.HTML5.Base
  14  , module Hdoc.DTC.Write.HTML5.Judgment
  15  -- , module Hdoc.DTC.Write.HTML5.Error
  16  ) where
  17
  18 import Control.Applicative (Applicative(..))
  19 import Control.Monad (Monad(..), (=<<), forM_, mapM_, sequence_)
  20 import Data.Bool
  21 import Data.Default.Class (Default(..))
  22 import Data.Either (Either(..))
  23 import Data.Eq (Eq(..))
  24 import Data.Foldable (Foldable(..), concat, fold)
  25 import Data.Function (($), (.), const,  on)
  26 import Data.Functor ((<$>), (<$))
  27 import Data.Functor.Compose (Compose(..))
  28 import Data.List.NonEmpty (NonEmpty(..))
  29 import Data.Locale hiding (Index)
  30 import Data.Maybe (Maybe(..), maybe, mapMaybe, isNothing, fromMaybe)
  31 import Data.Monoid (Monoid(..))
  32 import Data.Ord (Ord(..))
  33 import Prelude (succ)
  34 import Data.Sequence (Seq)
  35 import Data.Semigroup (Semigroup(..))
  36 import Data.String (String)
  37 import Data.TreeSeq.Strict (Tree(..), tree0)
  38 import Data.Tuple (snd)
  39 import System.FilePath ((</>))
  40 import System.IO (IO)
  41 import Text.Blaze ((!))
  42 import Text.Blaze.Html (Html)
  43 import Text.Show (Show(..))
  44 import qualified Control.Monad.Trans.RWS.Strict as RWS
  45 import qualified Control.Monad.Trans.Reader as R
  46 import qualified Data.HashMap.Strict as HM
  47 import qualified Data.HashSet as HS
  48 import qualified Data.List as List
  49 import qualified Data.Map.Strict as Map
  50 import qualified Data.Sequence as Seq
  51 import qualified Data.Strict.Maybe as Strict
  52 import qualified Data.Text as Text
  53 import qualified Data.Text.Lazy as TL
  54 import qualified Data.TreeMap.Strict as TM
  55 import qualified Safe
  56 import qualified Text.Blaze.Html5 as H
  57 import qualified Text.Blaze.Html5.Attributes  as HA
  58 import qualified Text.Blaze.Internal as H
  59
  60 import Control.Monad.Utils
  61 import Hdoc.DTC.Document as DTC
  62 import Hdoc.DTC.Write.HTML5.Base
  63 import Hdoc.DTC.Write.HTML5.Error ()
  64 import Hdoc.DTC.Write.HTML5.Ident
  65 import Hdoc.DTC.Write.HTML5.Judgment
  66 import Hdoc.DTC.Write.Plain (Plainify(..))
  67 import Hdoc.DTC.Write.XML ()
  68 import Hdoc.Utils
  69 import Text.Blaze.Utils
  70 import qualified Hdoc.DTC.Analyze.Check as Analyze
  71 import qualified Hdoc.DTC.Analyze.Collect as Analyze
  72 import qualified Hdoc.DTC.Analyze.Index as Analyze
  73 import qualified Hdoc.DTC.Write.Plain as Plain
  74 import qualified Hdoc.TCT.Cell as TCT
  75 import qualified Hdoc.Utils as FS
  76 import qualified Hdoc.XML as XML
  77 import qualified Paths_hdoc as Hdoc
  78 import Debug.Trace
  79
  80 debug :: Show a => String -> a -> a
  81 debug msg a = trace (msg<>": "<>show a) a
  82 debugOn :: Show b => String -> (a -> b) -> a -> a
  83 debugOn msg get a = trace (msg<>": "<>show (get a)) a
  84 debugWith :: String -> (a -> String) -> a -> a
  85 debugWith msg get a = trace (msg<>": "<>get a) a
  86
  87 writeHTML5 :: Config -> DTC.Document -> IO Html
  88 writeHTML5 conf@Config{..} doc_init = do
  89         let all_index = Analyze.collectIndex doc_init
  90         let (doc@DTC.Document{..}, all_irefs) =
  91                 Analyze.indexifyDocument (fold all_index) doc_init
  92         let all = Analyze.collect doc `R.runReader` def
  93         let err = Analyze.errors all
  94         let ro = def
  95                  { reader_l10n     = loqualize config_locale
  96                  , reader_plainify = def{Plain.reader_l10n = loqualize config_locale}
  97                  , reader_all      = all
  98                  -- , reader_body  = body
  99                  }
 100         let st = def
 101                  { state_errors  = debug "errors" $ Nat1 1 <$ err
 102                  , state_notes   = fold $ toList <$> Analyze.all_notes all
 103                  , state_indices =
 104                         (<$> toList all_index) $ \terms ->
 105                                 (terms,) $
 106                                 TM.intersection const all_irefs $
 107                                 Analyze.indexOfTerms terms
 108                  }
 109         let (html5Body, _endState, endWriter) =
 110                 runComposeRWS ro st $ do
 111                         analyseJudgments doc
 112                         html5ify err
 113                         html5ify doc
 114         html5Head <- writeHTML5Head conf ro endWriter doc
 115         return $ do
 116                 H.docType
 117                 H.html ! HA.lang (attrify $ countryCode config_locale) $ do
 118                         html5Head
 119                         H.body $ do
 120                                 {- NOTE:
 121                                 unless (null state_scripts) $ do
 122                                         -- NOTE: indicate that JavaScript is active.
 123                                         H.script ! HA.type_ "application/javascript" $
 124                                                 "document.body.className = \"script\";"
 125                                 -}
 126                                 html5Body
 127
 128 writeHTML5Head :: Config -> Reader -> Writer -> Document -> IO Html
 129 writeHTML5Head Config{..} Reader{..} Writer{..} Document{..} = do
 130         csss :: Html <- do
 131                 -- unless (any (\DTC.Link{..} -> link_rel == "stylesheet" && link_url /= URL "") links) $ do
 132                 (`foldMap` writer_styles) $ \case
 133                  Left css -> do
 134                         content <- FS.readFile =<< Hdoc.getDataFileName ("style"</>css)
 135                         return $ H.style ! HA.type_ "text/css" $
 136                                 H.toMarkup content
 137                  Right content -> return $ do
 138                         H.style ! HA.type_ "text/css" $
 139                                 -- NOTE: as a special case, H.style wraps its content into an External,
 140                                 -- so it does not HTML-escape its content.
 141                                 H.toMarkup content
 142         scripts :: Html <-
 143                 (`foldMap` writer_scripts) $ \script -> do
 144                         content <- FS.readFile =<< Hdoc.getDataFileName ("style"</>script)
 145                         return $ H.script ! HA.type_ "application/javascript" $
 146                                 H.toMarkup content
 147                 {-
 148                 if not (any (\DTC.Link{link_rel} -> link_rel == "script") links)
 149                  then do
 150                  else
 151                         mempty
 152                         case config_js of
 153                          Left "" -> mempty
 154                          Left  js -> H.script ! HA.src (attrify js)
 155                                               ! HA.type_ "application/javascript"
 156                                               $ mempty
 157                          Right js -> H.script ! HA.type_ "application/javascript"
 158                                               $ H.toMarkup js
 159                 -}
 160         return $
 161                 H.head $ do
 162                         H.meta ! HA.httpEquiv "Content-Type"
 163                                ! HA.content "text/html; charset=UTF-8"
 164                         unless (TL.null config_generator) $ do
 165                                 H.meta ! HA.name "generator"
 166                                        ! HA.content (attrify config_generator)
 167                         case document_head of
 168                          Nothing -> mempty
 169                          Just Head{head_section=Section{section_about=About{..}}, ..} -> do
 170                                 case about_titles of
 171                                  title:_ -> H.title $ H.toMarkup $ Plain.text reader_plainify title
 172                                  _ -> mempty
 173                                 forM_ about_links $ \Link{..} ->
 174                                         case link_rel of
 175                                          "stylesheet" | URL "" <- link_url ->
 176                                                 H.style ! HA.type_ "text/css" $
 177                                                         H.toMarkup $ Plain.text def link_plain
 178                                          _ ->
 179                                                 H.link ! HA.rel  (attrify link_rel)
 180                                                        ! HA.href (attrify link_url)
 181                                 unless (null about_tags) $
 182                                         H.meta ! HA.name "keywords"
 183                                                ! HA.content (attrify $ TL.intercalate ", " about_tags)
 184                                 let chapters =
 185                                         (`mapMaybe` toList document_body) $ \case
 186                                          Tree (BodySection s) _ -> Just s
 187                                          _ -> Nothing
 188                                 forM_ chapters $ \Section{..} ->
 189                                         H.link ! HA.rel "Chapter"
 190                                                ! HA.title (attrify $ plainify $ Safe.headDef def about_titles)
 191                                                ! HA.href (refIdent $ identify section_posXML)
 192                         case config_css of
 193                          Left "" -> mempty
 194                          Left css ->
 195                                 H.link ! HA.rel "stylesheet"
 196                                        ! HA.type_ "text/css"
 197                                        ! HA.href (attrify css)
 198                          Right css ->
 199                                 H.style ! HA.type_ "text/css" $
 200                                         H.toMarkup css
 201                         csss
 202                         scripts
 203
 204 instance Html5ify Document where
 205         html5ify Document{document_head=Nothing, ..} =
 206                 html5ify document_body
 207         html5ify Document{document_head=Just Head{..}, ..} = do
 208                 localComposeRWS (\ro -> ro{reader_section = [head_section], reader_body = body}) $ do
 209                         ro <- composeLift RWS.ask
 210                         unless (null about_authors) $ do
 211                                 H.div ! HA.class_ "document-head" $$
 212                                         H.table $$ do
 213                                                 H.tbody $$ do
 214                                                         H.tr $$ do
 215                                                                 H.td ! HA.class_ "left"  $$ html5Headers
 216                                                                 H.td ! HA.class_ "right" $$ html5Roles
 217                         unless (null about_titles) $ do
 218                                 H.div ! HA.class_ "title"
 219                                                         ! HA.id "document-title." $$ do
 220                                         forM_ about_titles $ \title ->
 221                                                 H.h1 ! HA.id (attrify $ identifyTitle (Plain.reader_l10n $ reader_plainify ro) title) $$
 222                                                         html5ify title
 223                         html5SectionJudgments
 224                         html5ify body
 225                 where
 226                 body = head_body <> document_body
 227                 Section{section_about=About{..}, ..} = head_section
 228                 html5Headers =
 229                         H.table ! HA.class_ "document-headers" $$
 230                                 H.tbody $$ do
 231                                         Loqualization l10n <- composeLift $ RWS.asks reader_l10n
 232                                         forM_ about_series $ \s@Serie{..} ->
 233                                                 header $
 234                                                         case urlSerie s of
 235                                                          Nothing -> do
 236                                                                 headerName  $ html5ify serie_name
 237                                                                 headerValue $ html5ify serie_id
 238                                                          Just href -> do
 239                                                                 headerName  $ html5ify serie_name
 240                                                                 headerValue $
 241                                                                         H.a ! HA.href (attrify href) $$
 242                                                                                 html5ify serie_id
 243                                         forM_ about_links $ \Link{..} ->
 244                                                 unless (TL.null $ unName link_role) $
 245                                                         header $ do
 246                                                                 headerName  $ html5ify link_role
 247                                                                 headerValue $ html5ify $ Tree PlainEref{eref_href=link_url} link_plain
 248                                         forM_ about_dates $ \d@Date{..} ->
 249                                                 header $ do
 250                                                         headerName $
 251                                                                 if TL.null $ unName date_role
 252                                                                 then l10n_Header_Date l10n
 253                                                                 else html5ify date_role
 254                                                         headerValue $ html5ify d
 255                                         {-
 256                                         forM_ about_headers $ \Header{..} ->
 257                                                 header $ do
 258                                                         headerName  $ html5ify header_name
 259                                                         headerValue $ html5ify header_value
 260                                         -}
 261                 html5Roles =
 262                         H.table ! HA.class_ "document-authors" $$
 263                                 H.tbody $$ do
 264                                         forM_ about_authors $ \a ->
 265                                                 H.tr $$
 266                                                         H.td ! HA.class_ "author" $$
 267                                                                 html5ify a
 268                 header :: HTML5 -> HTML5
 269                 header hdr = H.tr ! HA.class_ "header" $$ hdr
 270                 headerName :: HTML5 -> HTML5
 271                 headerName hdr =
 272                         H.td ! HA.class_ "header-name" $$ do
 273                                 hdr
 274                                 Loqualization l10n <- composeLift $ RWS.asks reader_l10n
 275                                 Plain.l10n_Colon l10n
 276                 headerValue :: HTML5 -> HTML5
 277                 headerValue hdr =
 278                         H.td ! HA.class_ "header-value" $$ do
 279                                 hdr
 280 instance Html5ify Body where
 281         html5ify body =
 282                 localComposeRWS (\ro -> ro{reader_body = body}) $ go body
 283                 where
 284                 go bs =
 285                         case Seq.viewl bs of
 286                          Seq.EmptyL ->
 287                                 popNotes >>= html5Notes
 288                          curr Seq.:< next -> do
 289                                 case curr of
 290                                  Tree BodySection{} _ -> popNotes >>= html5Notes
 291                                  _ -> mempty
 292                                 html5ify curr
 293                                 go next
 294 instance Html5ify (Tree BodyNode) where
 295         html5ify (Tree b bs) = do
 296                 case b of
 297                  BodyBlock blk -> html5ify blk
 298                  BodySection section@Section{section_about=About{..}, ..} -> do
 299                         localComposeRWS (\ro -> ro
 300                          { reader_section = section : reader_section ro
 301                          , reader_body    = bs
 302                          }) $ do
 303                                 Reader{reader_all=Analyze.All{..}} <- composeLift RWS.ask
 304                                 notes <- popNotes
 305                                 html5CommonAttrs section_attrs
 306                                  { attrs_classes = "section":attrs_classes section_attrs
 307                                  , attrs_id      = Nothing
 308                                  } $ do
 309                                         H.section ! HA.id (attrify $ identify section_posXML) $$ do
 310                                                 forM_ about_aliases html5ify
 311                                                 html5SectionJudgments
 312                                                 let mayId =
 313                                                         case attrs_id section_attrs of
 314                                                          Just ident | Just [_] <- toList <$> HM.lookup ident all_section ->
 315                                                                 Just $ identifyTag "" ident Nothing
 316                                                          _ -> Nothing
 317                                                 H.table
 318                                                  ! HA.class_ "section-header"
 319                                                  !?? mayAttr HA.id mayId $$
 320                                                         H.tbody $$
 321                                                                 case about_titles of
 322                                                                  [] ->
 323                                                                         H.tr $$ do
 324                                                                                 H.td ! HA.class_ "section-number" $$ do
 325                                                                                         html5SectionAnchor section
 326                                                                  title:titles -> do
 327                                                                         let hN = case List.length $ XML.pos_ancestors section_posXML of
 328                                                                                  0 -> H.h1
 329                                                                                  1 -> H.h2
 330                                                                                  2 -> H.h3
 331                                                                                  3 -> H.h4
 332                                                                                  4 -> H.h5
 333                                                                                  5 -> H.h6
 334                                                                                  _ -> H.h6
 335                                                                         H.tr $$ do
 336                                                                                 H.td ! HA.class_ "section-number" $$ do
 337                                                                                         html5SectionAnchor section
 338                                                                                 H.td ! HA.class_ "section-title" $$ do
 339                                                                                         hN $$
 340                                                                                                 html5ify title
 341                                                                         forM_ titles $ \t ->
 342                                                                                 H.tr $$ do
 343                                                                                         H.td $$ mempty
 344                                                                                         H.td ! HA.class_ "section-title" $$ do
 345                                                                                                 hN $$
 346                                                                                                         html5ify t
 347                                                 html5ify bs
 348                                         html5Notes notes
 349                                                 {- FIXME
 350                                                 do -- notes
 351                                                         notes <- composeLift $ S.gets state_notes
 352                                                         maybe mempty html5Notes $
 353                                                                 Map.lookup (XML.pos_ancestors section_posXML) notes
 354                                                 -}
 355 instance Html5ify Block where
 356         html5ify = \case
 357          BlockPara para -> html5ify para
 358          BlockBreak{..} ->
 359                 html5CommonAttrs attrs
 360                  { attrs_classes = "page-break":"print-only":attrs_classes attrs } $
 361                 H.div $$
 362                         H.p $$ " " -- NOTE: force page break
 363          BlockToC{..} ->
 364                 H.nav ! HA.class_ "toc"
 365                       ! HA.id (attrify $ identify posXML) $$ do
 366                         H.span ! HA.class_ "toc-name" $$
 367                                 H.a ! HA.href (refIdent $ identify posXML) $$ do
 368                                         Loqualization l10n <- composeLift $ RWS.asks reader_l10n
 369                                         Plain.l10n_Table_of_Contents l10n
 370                         H.ul $$ do
 371                                 Reader{reader_body} <- composeLift RWS.ask
 372                                 forM_ reader_body $ html5ifyToC depth
 373          BlockToF{..} -> do
 374                 H.nav ! HA.class_ "tof"
 375                       ! HA.id (attrify $ identify posXML) $$
 376                         H.table ! HA.class_ "tof" $$
 377                                 H.tbody $$
 378                                         html5ifyToF types
 379          BlockAside{..} ->
 380                 html5CommonAttrs attrs $
 381                 H.aside ! HA.class_ "aside" $$ do
 382                         forM_ blocks html5ify
 383          BlockFigure{..} ->
 384                 html5CommonAttrs attrs
 385                  { attrs_classes = "figure":("figure-"<>type_):attrs_classes attrs
 386                  , attrs_id      = Just $ identify $ XML.pos_ancestorsWithFigureNames posXML
 387                  } $
 388                 H.div $$ do
 389                         H.table ! HA.class_ "figure-caption" $$
 390                                 H.tbody $$
 391                                         H.tr $$ do
 392                                                 if TL.null type_
 393                                                  then H.a ! HA.href (refIdent $ identify posXML) $$ mempty
 394                                                  else
 395                                                         H.td ! HA.class_ "figure-number" $$ do
 396                                                                 H.a ! HA.href (refIdent $ identify $ XML.pos_ancestorsWithFigureNames posXML) $$ do
 397                                                                         html5ify type_
 398                                                                         html5ify $ XML.pos_ancestorsWithFigureNames posXML
 399                                                 forM_ mayTitle $ \title -> do
 400                                                         H.td ! HA.class_ "figure-colon" $$ do
 401                                                                 unless (TL.null type_) $ do
 402                                                                         Loqualization l10n <- composeLift $ RWS.asks reader_l10n
 403                                                                         Plain.l10n_Colon l10n
 404                                                         H.td ! HA.class_ "figure-title" $$ do
 405                                                                 html5ify title
 406                         H.div ! HA.class_ "figure-content" $$ do
 407                                 html5ify paras
 408          BlockIndex{posXML} -> do
 409                 State{..} <- composeLift RWS.get
 410                 composeLift $ do
 411                         RWS.tell def
 412                          { writer_styles = HS.singleton $ Left "dtc-index.css" }
 413                         RWS.modify $ \s -> s{state_indices=List.tail state_indices}
 414                 let (allTerms,refsByTerm) = List.head state_indices
 415                 let chars = Analyze.termsByChar allTerms
 416                 H.div ! HA.class_ "index"
 417                       ! HA.id (attrify $ identify posXML) $$ do
 418                         H.nav ! HA.class_ "index-nav" $$ do
 419                                 forM_ (Map.keys chars) $ \char ->
 420                                         H.a ! HA.href (refIdent (identify posXML <> "." <> identify char)) $$
 421                                                 html5ify char
 422                         H.dl ! HA.class_ "index-chars" $$
 423                                 forM_ (Map.toList chars) $ \(char,terms) -> do
 424                                         H.dt $$ do
 425                                                 let i = identify posXML <> "." <> identify char
 426                                                 H.a ! HA.id (attrify i)
 427                                                     ! HA.href (refIdent i) $$
 428                                                         html5ify char
 429                                         H.dd $$
 430                                                 H.dl ! HA.class_ "index-term" $$ do
 431                                                 forM_ terms $ \aliases -> do
 432                                                         H.dt $$
 433                                                                 H.ul ! HA.class_ "index-aliases" $$
 434                                                                         forM_ (List.take 1 aliases) $ \term -> do
 435                                                                                 H.li ! HA.id (attrify $ identifyIref term Nothing) $$
 436                                                                                         html5ify term
 437                                                         H.dd $$ do
 438                                                                 let sortedRefs =
 439                                                                         List.sortBy (compare `on` snd) $
 440                                                                         (`foldMap` aliases) $ \term ->
 441                                                                                 fromMaybe def $ do
 442                                                                                         path <- DTC.pathFromWords term
 443                                                                                         refs <- Strict.maybe Nothing Just $ TM.lookup path refsByTerm
 444                                                                                         return $
 445                                                                                                 Seq.foldrWithIndex (\num ref acc -> ((term, succ num), ref):acc) [] $
 446                                                                                                 Seq.reverse refs
 447                                                                 html5CommasDot $
 448                                                                         (<$> sortedRefs) $ \((term, num), section) ->
 449                                                                                 H.a ! HA.class_ "index-iref"
 450                                                                                     ! HA.href (refIdent $ identifyIref term $ Just $ Nat1 num) $$
 451                                                                                         html5ify $ XML.pos_ancestors $ section_posXML section
 452          BlockReferences{..} ->
 453                 html5CommonAttrs attrs
 454                  { attrs_classes = "references":attrs_classes attrs
 455                  , attrs_id      = Just $ identify $ XML.pos_ancestors posXML
 456                  } $
 457                 H.div $$ do
 458                         H.table $$
 459                                 forM_ refs html5ify
 460          BlockGrades{..} ->
 461                 html5CommonAttrs attrs
 462                  { attrs_classes = "grades":attrs_classes attrs
 463                  , attrs_id      = Just $ identify $ XML.pos_ancestors posXML
 464                  } $
 465                 H.div $$ do
 466                         -- let dg = List.head $ List.filter default_ scale
 467                         -- let sc = MJ.Scale (Set.fromList scale) dg
 468                         -- o  :: Map choice grade
 469                         -- os :: Opinions (Map judge (Opinion choice grade))
 470                         mempty
 471                         -- html5ify $ show b
 472          BlockJudges js -> html5ify js
 473 instance Html5ify Para where
 474         html5ify = \case
 475          ParaItem{..} ->
 476                 html5CommonAttrs def
 477                  { attrs_classes = "para":cls item
 478                  } $
 479                         html5ify item
 480          ParaItems{..} ->
 481                 html5CommonAttrs attrs
 482                  { attrs_classes = "para":attrs_classes attrs
 483                  , attrs_id      = id_ posXML
 484                  } $
 485                 H.div $$
 486                         forM_ items $ \item ->
 487                                 html5AttrClass (cls item) $
 488                                 html5ify item
 489          where
 490                 id_ = Just . identify . XML.pos_ancestors
 491                 cls = \case
 492                  ParaPlain{}      -> []
 493                  ParaArtwork{..}  -> ["artwork", "artwork-"<>type_]
 494                  ParaQuote{..}    -> ["quote", "quote-"<>type_]
 495                  ParaComment{}    -> []
 496                  ParaOL{}         -> ["ol"]
 497                  ParaUL{}         -> ["ul"]
 498                  ParaJudgment Judgment{..} -> ["judgment"] <> when (null judgment_opinionsByChoice) ["judgment-error"]
 499 instance Html5ify ParaItem where
 500         html5ify = \case
 501          ParaPlain p -> H.p $$ html5ify p
 502          ParaArtwork{..} -> H.pre $$ do html5ify text
 503          ParaQuote{..} -> H.div $$ do html5ify paras
 504          ParaComment t -> html5ify $ H.Comment (H.String $ TL.unpack t) ()
 505          ParaOL items ->
 506                 H.dl $$ do
 507                         forM_ items $ \ListItem{..} -> do
 508                                 H.dt ! HA.class_ "name" $$ do
 509                                         html5ify name
 510                                         "."::HTML5
 511                                 H.dd ! HA.class_ "value" $$
 512                                         html5ify paras
 513          ParaUL items ->
 514                 H.dl $$ do
 515                         forM_ items $ \item -> do
 516                                 H.dt $$ "—"
 517                                 H.dd $$ html5ify item
 518          ParaJudgment j -> html5ify j
 519 instance Html5ify [Para] where
 520         html5ify = mapM_ html5ify
 521 instance Html5ify Plain where
 522         html5ify ps =
 523                 case Seq.viewl ps of
 524                  Seq.EmptyL -> mempty
 525                  curr Seq.:< next ->
 526                         case curr of
 527                         -- NOTE: gather adjacent PlainNotes
 528                          Tree PlainNote{} _
 529                           | (notes, rest) <- Seq.spanl (\case {Tree PlainNote{} _ -> True; _ -> False}) next -> do
 530                                 H.sup ! HA.class_ "note-numbers" $$ do
 531                                         html5ify curr
 532                                         forM_ notes $ \note -> do
 533                                                 ", "::HTML5
 534                                                 html5ify note
 535                                 " "::HTML5
 536                                 html5ify rest
 537                         --
 538                          _ -> do
 539                                 html5ify curr
 540                                 html5ify next
 541 instance Html5ify (Tree PlainNode)
 542  where html5ify (Tree n ps) =
 543         case n of
 544          PlainBreak  -> html5ify H.br
 545          PlainText t -> html5ify t
 546          PlainGroup  -> html5ify ps
 547          PlainB      -> H.strong $$ html5ify ps
 548          PlainCode   -> H.code   $$ html5ify ps
 549          PlainDel    -> H.del    $$ html5ify ps
 550          PlainI -> do
 551                 i <- composeLift $ RWS.asks reader_italic
 552                 H.em ! HA.class_ (if i then "even" else "odd") $$
 553                         localComposeRWS (\ro -> ro{reader_italic=not i}) $
 554                                 html5ify ps
 555          PlainSpan{..} ->
 556                 html5CommonAttrs attrs $
 557                 H.span $$ html5ify ps
 558          PlainSub  -> H.sub    $$ html5ify ps
 559          PlainSup  -> H.sup    $$ html5ify ps
 560          PlainSC   -> H.span ! HA.class_ "smallcaps" $$ html5ify ps
 561          PlainU    -> H.span ! HA.class_ "underline" $$ html5ify ps
 562          PlainNote{..} -> do
 563                 num <- composeLift $ do
 564                         num <- RWS.gets state_note_num_ref
 565                         RWS.modify $ \s -> s{state_note_num_ref=succNat1 num}
 566                         return num
 567                 H.a ! HA.class_ "note-ref"
 568                     ! HA.id ("note-ref."<>attrify num)
 569                     ! HA.href ("#note."<>attrify num) $$
 570                         html5ify num
 571          PlainQ -> do
 572                 H.span ! HA.class_ "q" $$ do
 573                         Loqualization l10n <- composeLift $ RWS.asks reader_l10n
 574                         Plain.l10n_Quote (html5ify $ Tree PlainI ps) l10n
 575         -- <eref>
 576          PlainEref{..} -> do
 577                 H.a ! HA.class_ "eref no-print"
 578                     ! HA.href (attrify eref_href) $$
 579                         if null ps
 580                         then html5ify $ unURL eref_href
 581                         else html5ify ps
 582                 H.span ! HA.class_ "eref print-only" $$ do
 583                         unless (null ps) $ do
 584                                 html5ify ps
 585                                 " "::HTML5
 586                         "<"::HTML5
 587                         html5ify eref_href
 588                         ">"
 589         -- <tag>
 590          PlainTag{..}
 591           -- backward
 592           | tag_back -> do
 593                 Reader{reader_all=Analyze.All{..}} <- composeLift RWS.ask
 594                 State{state_errors=Analyze.Errors{..}} <- composeLift RWS.get
 595                 case HM.lookup tag_ident all_tag of
 596                  Nothing -> pure ()
 597                  Just anchs ->
 598                         H.span ! HA.class_ "tag-backs" $$
 599                                 html5Commas $
 600                                 (<$> List.zip (toList anchs) [1..]) $ \((_loc, maySection),idNum) ->
 601                                         H.a ! HA.class_ "tag-back"
 602                                             ! HA.href (refIdent $ identifyTag "-back" tag_ident $ Just $ Nat1 idNum) $$
 603                                                 html5SectionNumber maySection
 604           -- forward
 605           | otherwise -> do
 606                 State{state_tag} <- composeLift RWS.get
 607                 let idNum = HM.lookupDefault (Nat1 1) tag_ident state_tag
 608                 composeLift $ RWS.modify $ \s -> s
 609                  { state_tag = HM.insert tag_ident (succNat1 idNum) state_tag }
 610                 H.span ! HA.class_ "tag"
 611                        ! HA.id (attrify $ identifyTag "-back" tag_ident $ Just idNum) $$
 612                         html5ify tag_ident
 613         -- <at>
 614          PlainAt{..}
 615           -- backward
 616           | at_back -> do
 617                 Reader{reader_all=Analyze.All{..}} <- composeLift RWS.ask
 618                 State{state_errors=Analyze.Errors{..}} <- composeLift RWS.get
 619                 case HM.lookup at_ident all_at of
 620                  Nothing -> pure ()
 621                  Just anchs ->
 622                         H.span ! HA.class_ "at-backs" $$
 623                                 html5Commas $
 624                                 (<$> List.zip (toList anchs) [1..]) $ \((_loc, maySection),idNum) ->
 625                                         H.a ! HA.class_ "at-back"
 626                                             ! HA.href (refIdent $ identifyAt "-back" at_ident $ Just $ Nat1 idNum) $$
 627                                                 html5SectionNumber maySection
 628           -- forward
 629           | otherwise -> do
 630                 Reader{..} <- composeLift RWS.ask
 631                 State{state_errors=errs@Analyze.Errors{..}, ..} <- composeLift RWS.get
 632                 let idNum = HM.lookupDefault (Nat1 1) at_ident state_at
 633                 composeLift $ RWS.modify $ \s -> s
 634                  { state_at = HM.insert at_ident (succNat1 idNum) state_at }
 635                 case () of
 636                 -- unknown
 637                  _ | Just errNum <- HM.lookup at_ident errors_at_unknown -> do
 638                         composeLift $ RWS.modify $ \s -> s
 639                          { state_errors = errs
 640                                  { Analyze.errors_at_unknown =
 641                                         HM.adjust succNat1 at_ident errors_at_unknown } }
 642                         H.span
 643                          ! HA.class_ "at at-unknown"
 644                          ! HA.id (attrify $ identifyAt "-unknown" at_ident (Just errNum)) $$
 645                                 H.span
 646                                  ! HA.class_ "at at-unknown"
 647                                  ! HA.id (attrify $ identifyAt "-back" at_ident $ Just idNum) $$
 648                                         html5ify at_ident
 649                 -- ambiguous
 650                    | Just errNum <- HM.lookup at_ident errors_at_ambiguous -> do
 651                         composeLift $ RWS.modify $ \s -> s
 652                          { state_errors = errs
 653                                  { Analyze.errors_at_ambiguous =
 654                                         HM.adjust succNat1 at_ident errors_at_ambiguous } }
 655                         H.span
 656                          ! HA.class_ "at at-ambiguous"
 657                          ! HA.id (attrify $ identifyAt "-ambiguous" at_ident (Just errNum)) $$
 658                                 H.span
 659                                  ! HA.class_ "at at-ambiguous"
 660                                  ! HA.id (attrify $ identifyAt "-back" at_ident $ Just idNum) $$
 661                                         html5ify at_ident
 662                 -- known
 663                    | otherwise -> do
 664                         H.a
 665                          ! HA.class_ "at"
 666                          ! HA.href (refIdent $ identifyAt "" at_ident Nothing)
 667                          ! HA.id (attrify $ identifyAt "-back" at_ident $ Just idNum) $$
 668                                 html5ify at_ident
 669         -- <ref>
 670          PlainRef{..} -> do
 671                 Reader{reader_all=Analyze.All{..}} <- composeLift RWS.ask
 672                 State{state_errors=errs@Analyze.Errors{..}, ..} <- composeLift RWS.get
 673                 let idNum = HM.lookupDefault (Nat1 1) ref_ident state_ref
 674                 composeLift $ RWS.modify $ \s -> s
 675                  { state_ref = HM.insert ref_ident (succNat1 idNum) state_ref }
 676                 case toList $ HM.lookupDefault def ref_ident all_reference of
 677                 -- unknown
 678                  [] -> do
 679                         let errNum = HM.lookup ref_ident errors_ref_unknown
 680                         composeLift $ RWS.modify $ \s -> s
 681                          { state_errors = errs
 682                                  { Analyze.errors_ref_unknown =
 683                                         HM.adjust succNat1 ref_ident errors_ref_unknown } }
 684                         H.span
 685                          ! HA.class_ "reference reference-unknown"
 686                          ! HA.id (attrify $ identifyReference "-unknown" ref_ident errNum) $$ do
 687                                 "["::HTML5
 688                                 html5ify ref_ident
 689                                 "]"
 690                 -- known
 691                  [Reference{..}] -> do
 692                         let a = H.a ! HA.href (refIdent $ identifyReference "" ref_ident Nothing)
 693                         let ref = do
 694                                 H.span
 695                                  ! HA.class_ "reference"
 696                                  ! HA.id (attrify  $ identifyReference "" ref_ident $ Just idNum) $$ do
 697                                         "["::HTML5
 698                                         a $$ html5ify ref_ident
 699                                         "]"
 700                         case toList ps of
 701                          [] -> ref
 702                          [Tree (PlainText "") _] -> do
 703                                 refs <- composeLift $ RWS.asks $ Analyze.all_reference . reader_all
 704                                 case toList <$> HM.lookup ref_ident refs of
 705                                  Just [Reference{reference_about=About{..}}] -> do
 706                                         forM_ (List.take 1 about_titles) $ \(Title title) -> do
 707                                                 html5ify $ Tree PlainQ $
 708                                                         case List.filter ((\rel -> rel == "" || rel == "self") . link_rel) about_links of
 709                                                          [] -> title
 710                                                          Link{..}:_ -> pure $ Tree (PlainEref link_url) title
 711                                                 " "::HTML5
 712                                                 ref
 713                                  _ -> mempty
 714                          _ -> do
 715                                 a $$ html5ify ps
 716                                 H.span ! HA.class_ "print-only" $$ do
 717                                         " "::HTML5
 718                                         ref
 719                 -- ambiguous
 720                  _ -> do
 721                         case toList ps of
 722                          [] -> mempty
 723                          [Tree (PlainText "") _] -> mempty
 724                          _ -> do
 725                                 html5ify ps
 726                                 " "::HTML5
 727                         H.span ! HA.class_ "reference reference-ambiguous" $$ do
 728                                 "["::HTML5
 729                                 html5ify ref_ident
 730                                 "]"
 731         -- <iref>
 732          PlainIref{..} ->
 733                 case pathFromWords iref_term of
 734                  Nothing -> html5ify ps
 735                  Just path -> do
 736                         Reader{reader_all=Analyze.All{..}} <- composeLift RWS.ask
 737                         State{state_irefs} <- composeLift RWS.get
 738                         let num = Strict.fromMaybe (Nat1 1) $ TM.lookup path state_irefs
 739                         composeLift $ RWS.modify $ \s -> s
 740                          { state_irefs = TM.insert const path (succNat1 num) state_irefs }
 741                         H.span ! HA.class_ "iref"
 742                                ! HA.id (attrify $ identifyIref iref_term $ Just num) $$
 743                                 html5ify ps
 744 instance Html5ify [Title] where
 745         html5ify =
 746                 html5ify . fold . List.intersperse sep . toList
 747                 where sep = Title $ Seq.singleton $ tree0 $ PlainText " — "
 748 instance Html5ify Title where
 749         html5ify (Title t) = html5ify t
 750 instance Html5ify About where
 751         html5ify About{..} = do
 752                 Loqualization l10n <- composeLift $ RWS.asks reader_l10n
 753                 H.p $$
 754                         html5CommasDot $ concat
 755                          [ html5Titles about_titles
 756                          , html5ify <$> about_authors
 757                          , html5ify <$> about_dates
 758                          , html5ify <$> about_series
 759                          ]
 760                 forM_ about_links $ \Link{..} ->
 761                         case () of
 762                          _ | link_rel == ""
 763                           || link_rel == "self" ->
 764                                 H.p ! HA.class_ "reference-url print-only" $$ do
 765                                         html5ify $ Tree PlainEref{eref_href=link_url} link_plain
 766                          _ ->
 767                                 H.p ! HA.class_ "reference-url" $$ do
 768                                         html5ify link_role
 769                                         Plain.l10n_Colon l10n :: HTML5
 770                                         html5ify $ Tree PlainEref{eref_href=link_url} link_plain
 771                 forM_ about_description $ \description -> do
 772                         H.div ! HA.class_ "reference-description" $$ do
 773                                 html5ify description
 774                 where
 775                 html5Titles :: [Title] -> [HTML5]
 776                 html5Titles ts | null ts = []
 777                 html5Titles ts = [html5Title $ joinTitles ts]
 778                         where
 779                         joinTitles = fold . List.intersperse sep . toList
 780                         sep = Title $ Seq.singleton $ tree0 $ PlainText " — "
 781                 html5Title (Title title) = do
 782                         H.span ! HA.class_ "no-print" $$
 783                                 html5ify $ Tree PlainQ $
 784                                         case List.filter ((\rel -> rel == "" || rel == "self") . link_rel) about_links of
 785                                          [] -> title
 786                                          Link{..}:_ -> pure $ Tree (PlainEref link_url) title
 787                         H.span ! HA.class_ "print-only" $$
 788                                 html5ify $ Tree PlainQ title
 789 instance Html5ify Serie where
 790         html5ify s@Serie{..} = do
 791                 Loqualization l10n <- composeLift $ RWS.asks reader_l10n
 792                 case urlSerie s of
 793                  Nothing -> do
 794                         html5ify serie_name
 795                         Plain.l10n_Colon l10n :: HTML5
 796                         html5ify serie_id
 797                  Just href -> do
 798                         html5ify $
 799                                 Tree PlainEref{eref_href=href} $
 800                                 Seq.fromList
 801                                  [ tree0 $ PlainText $ unName serie_name
 802                                  , tree0 $ PlainText $ Plain.l10n_Colon l10n
 803                                  , tree0 $ PlainText serie_id
 804                                  ]
 805 instance Html5ify Entity where
 806         html5ify Entity{..} = do
 807                 case () of
 808                  _ | not (TL.null entity_email) -> do
 809                         H.span ! HA.class_ "no-print" $$ do
 810                                 html5ify $
 811                                         Tree (PlainEref $ URL $ "mailto:"<>entity_email) $
 812                                                 pure $ tree0 $ PlainText entity_name
 813                                 html5ify $ orgs entity_org
 814                         H.span ! HA.class_ "print-only" $$
 815                                 html5ify $
 816                                         Tree (PlainEref $ URL entity_email) $
 817                                                 pure $ tree0 $ PlainText $
 818                                                         entity_name <> orgs entity_org
 819                         where
 820                         orgs = foldMap $ \Entity{entity_name=name, entity_org=org} -> " ("<>name<>orgs org<>")"
 821                  _ | Just u <- entity_url ->
 822                         html5ify $
 823                                 Tree (PlainEref u) $
 824                                         pure $ tree0 $ PlainText entity_name
 825                  _ ->
 826                         html5ify $
 827                                 tree0 $ PlainText entity_name
 828 instance Html5ify Words where
 829         html5ify = html5ify . Analyze.plainifyWords
 830 instance Html5ify Alias where
 831         html5ify Alias{..} = do
 832                 Reader{reader_all=Analyze.All{..}} <- composeLift RWS.ask
 833                 let mayId =
 834                         case attrs_id alias_attrs of
 835                          Just ident | Just [_] <- toList <$> HM.lookup ident all_section ->
 836                                 Just $ identifyTag "" ident Nothing
 837                          _ -> Nothing
 838                 H.a ! HA.class_ "alias"
 839                     !?? mayAttr HA.id mayId $$
 840                         mempty
 841 instance Html5ify URL where
 842         html5ify (URL url) =
 843                 H.a ! HA.class_ "url"
 844                     ! HA.href (attrify url) $$
 845                         html5ify url
 846 instance Html5ify Date where
 847         html5ify date@Date{..} = do
 848                 Loqualization l10n <- composeLift $ RWS.asks reader_l10n
 849                 case (date_rel, date_role) of
 850                  ("", "") -> ""::HTML5
 851                  (_, "") -> do
 852                         html5ify date_rel
 853                         Plain.l10n_Colon l10n
 854                  _ -> do
 855                         html5ify date_role
 856                         Plain.l10n_Colon l10n
 857                 Plain.l10n_Date date l10n
 858 instance Html5ify Reference where
 859         html5ify Reference{..} = do
 860                 Reader{reader_all=Analyze.All{..}} <- composeLift RWS.ask
 861                 State{state_errors=errs@Analyze.Errors{..}, ..} <- composeLift RWS.get
 862                 H.tr $$ do
 863                         H.td ! HA.class_ "reference-key" $$ do
 864                                 "["::HTML5
 865                                 case HM.lookup reference_id errors_reference_ambiguous of
 866                                  Nothing ->
 867                                         H.a ! HA.class_ "reference"
 868                                             ! HA.href (refIdent $ identifyReference "" reference_id Nothing)
 869                                             ! HA.id   (attrify  $ identifyReference "" reference_id Nothing) $$
 870                                                 html5ify reference_id
 871                                  Just errNum -> do
 872                                         composeLift $ RWS.modify $ \s -> s
 873                                          { state_errors = errs
 874                                                  { Analyze.errors_reference_ambiguous =
 875                                                         HM.insert reference_id (succNat1 errNum) errors_reference_ambiguous } }
 876                                         H.span ! HA.class_ "reference reference-ambiguous"
 877                                                ! HA.id (attrify $ identifyReference "-ambiguous" reference_id $ Just errNum) $$
 878                                                 html5ify reference_id
 879                                 "]"
 880                         H.td ! HA.class_ "reference-content" $$ do
 881                                 html5ify reference_about
 882                                 case HM.lookup reference_id all_ref of
 883                                  Nothing -> pure ()
 884                                  Just anchs ->
 885                                         when (isNothing $ HM.lookup reference_id errors_reference_ambiguous) $ do
 886                                                 H.p ! HA.class_ "ref-backs" $$
 887                                                         html5CommasDot $
 888                                                         (<$> List.zip (toList anchs) [1..]) $ \((_loc, maySection),num) ->
 889                                                                 H.a ! HA.class_ "ref-back"
 890                                                                     ! HA.href (refIdent $ identifyReference "" reference_id $ Just $ Nat1 num) $$
 891                                                                         html5SectionNumber maySection
 892 instance Html5ify XML.Ancestors where
 893         html5ify ancs =
 894                 case toList ancs of
 895                  [(_n,c)] -> do
 896                         html5ify $ show c
 897                         html5ify '.'
 898                  as ->
 899                         html5ify $
 900                                 Text.intercalate "." $
 901                                 Text.pack . show . snd <$> as
 902 instance Html5ify Plain.Plain where
 903         html5ify p = do
 904                 rp <- composeLift $ RWS.asks reader_plainify
 905                 html5ify $ Plain.runPlain p rp
 906 instance Html5ify TCT.Location where
 907         html5ify = \case
 908          s:|[] ->
 909                 H.span ! HA.class_ "tct-location" $$
 910                         html5ify $ show s
 911          ss -> do
 912                 H.ul ! HA.class_ "tct-location" $$
 913                         forM_ ss $ \s ->
 914                                 H.li $$
 915                                         html5ify $ show s
 916 {-
 917 instance Html5ify SVG.Element where
 918         html5ify svg =
 919                 html5ify $
 920                 B.preEscapedLazyText $
 921                 SVG.renderText svg
 922 instance Semigroup SVG.Element where
 923         (<>) = mappend
 924 -}
 925
 926 html5Commas :: [HTML5] -> HTML5
 927 html5Commas [] = pure ()
 928 html5Commas hs = do
 929         sequence_ $ List.intersperse ", " hs
 930
 931 html5CommasDot :: [HTML5] -> HTML5
 932 html5CommasDot [] = pure ()
 933 html5CommasDot hs = do
 934         html5Commas hs
 935         "."
 936
 937 html5Lines :: [HTML5] -> HTML5
 938 html5Lines hs = sequence_ $ List.intersperse (html5ify H.br) hs
 939
 940 html5Words :: [HTML5] -> HTML5
 941 html5Words hs = sequence_ $ List.intersperse " " hs
 942
 943 html5SectionAnchor :: Section -> HTML5
 944 html5SectionAnchor = go mempty . XML.pos_ancestors . section_posXML
 945         where
 946         go :: XML.Ancestors -> XML.Ancestors -> HTML5
 947         go prev next =
 948                 case Seq.viewl next of
 949                  Seq.EmptyL -> pure ()
 950                  a@(_n,rank) Seq.:< as -> do
 951                         H.a ! HA.href (refIdent $ identify $ prev Seq.|> a) $$
 952                                 html5ify $ show rank
 953                         when (not (null as) || null prev) $ do
 954                                 html5ify '.'
 955                                 go (prev Seq.|>a) as
 956
 957 html5SectionTo :: Section -> HTML5
 958 html5SectionTo Section{..} =
 959         H.a ! HA.href (refIdent $ identify ancestors) $$
 960                 html5ify ancestors
 961         where ancestors = XML.pos_ancestors section_posXML
 962
 963 html5SectionNumber :: Section -> HTML5
 964 html5SectionNumber Section{..} =
 965         html5ify $ XML.pos_ancestors section_posXML
 966
 967 popNotes :: ComposeRWS Reader Writer State H.MarkupM (Seq [Para])
 968 popNotes = do
 969         st <- composeLift RWS.get
 970         case {-debug "state_notes" $-} state_notes st of
 971          [] -> return mempty
 972          curr:next -> do
 973                 composeLift $ RWS.modify $ \s -> s{state_notes=next}
 974                 return curr
 975
 976 html5Notes :: Seq [Para] -> HTML5
 977 html5Notes notes = do
 978         unless (null notes) $ do
 979                 H.aside ! HA.class_ "notes" $$ do
 980                         Compose $ pure H.hr
 981                         H.table $$
 982                                 H.tbody $$
 983                                         forM_ notes $ \content -> do
 984                                                 num <- composeLift $ do
 985                                                         n <- RWS.gets state_note_num_content
 986                                                         RWS.modify $ \s -> s{state_note_num_content=succNat1 n}
 987                                                         return n
 988                                                 H.tr $$ do
 989                                                         H.td ! HA.class_ "note-ref" $$ do
 990                                                                 H.a ! HA.class_ "note-number"
 991                                                                     ! HA.id   ("note."<>attrify num)
 992                                                                     ! HA.href ("#note."<>attrify num) $$ do
 993                                                                         html5ify num
 994                                                                 ". "::HTML5
 995                                                                 H.a ! HA.href ("#note-ref."<>attrify num) $$ do
 996                                                                         "↑"
 997                                                         H.td $$
 998                                                                 html5ify content
 999
1000 html5ifyToC :: Maybe DTC.Nat -> Tree BodyNode -> HTML5
1001 html5ifyToC depth (Tree b bs) =
1002         case b of
1003          BodySection section@Section{section_about=About{..}, ..} -> do
1004                 H.li $$ do
1005                         H.table ! HA.class_ "toc-entry" $$
1006                                 H.tbody $$
1007                                         case about_titles of
1008                                          [] ->
1009                                                 H.tr $$ do
1010                                                         H.td ! HA.class_ "section-number" $$
1011                                                                 html5SectionTo section
1012                                          title:titles -> do
1013                                                 H.tr $$ do
1014                                                         H.td ! HA.class_ "section-number" $$
1015                                                                 html5SectionTo section
1016                                                         H.td ! HA.class_ "section-title" $$
1017                                                                 html5ify $ cleanPlain $ unTitle title
1018                                                 forM_ titles $ \t ->
1019                                                         H.tr $$ do
1020                                                                 H.td ! HA.class_ "section-title" $$
1021                                                                         html5ify $ cleanPlain $ unTitle t
1022                         when (maybe True (> Nat 1) depth && not (null sections)) $
1023                                 H.ul $$
1024                                         forM_ sections $
1025                                                 html5ifyToC (depth >>= predNat)
1026          _ -> mempty
1027         where
1028         sections =
1029                 (`Seq.filter` bs) $ \case
1030                  Tree BodySection{} _ -> True
1031                  _ -> False
1032
1033 html5ifyToF :: [TL.Text] -> HTML5
1034 html5ifyToF types = do
1035         figuresByType <- composeLift $ RWS.asks $ Analyze.all_figure . reader_all
1036         let figures =
1037                 Map.unions $
1038                 ((\(ty,ts) -> (ty,) <$> ts) <$>) $
1039                 HM.toList $
1040                 if null types
1041                 then figuresByType
1042                 else
1043                         HM.intersection figuresByType $
1044                         HM.fromList [(ty,()) | ty <- types]
1045         forM_ (Map.toList figures) $ \(posXML, (type_, title)) ->
1046                 H.tr $$ do
1047                         H.td ! HA.class_ "figure-number" $$
1048                                 H.a ! HA.href (refIdent $ identify posXML) $$ do
1049                                         html5ify type_
1050                                         html5ify $ XML.pos_ancestors posXML
1051                         forM_ title $ \ti ->
1052                                 H.td ! HA.class_ "figure-title" $$
1053                                         html5ify $ cleanPlain $ unTitle ti
1054
1055 -- 'Attrify'
1056 instance Attrify Plain.Plain where
1057         attrify p = attrify $ Plain.runPlain p def