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