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                                 let About{..} = reference_about
 705                                 forM_ (List.take 1 about_titles) $ \(Title title) -> do
 706                                         html5ify $ Tree PlainQ $
 707                                                 case List.filter ((\rel -> rel == "" || rel == "self") . link_rel) about_links of
 708                                                  [] -> title
 709                                                  Link{..}:_ -> pure $ Tree (PlainEref link_url) title
 710                                         " "::HTML5
 711                                         ref
 712                          _ -> do
 713                                 a $$ html5ify ps
 714                                 H.span ! HA.class_ "print-only" $$ do
 715                                         " "::HTML5
 716                                         ref
 717                 -- ambiguous
 718                  _ -> do
 719                         case toList ps of
 720                          [] -> mempty
 721                          [Tree (PlainText "") _] -> mempty
 722                          _ -> do
 723                                 html5ify ps
 724                                 " "::HTML5
 725                         H.span ! HA.class_ "reference reference-ambiguous" $$ do
 726                                 "["::HTML5
 727                                 html5ify ref_ident
 728                                 "]"
 729         -- <page-ref>
 730          PlainPageRef{..} -> do
 731                 Reader{reader_all=Analyze.All{..}} <- composeLift RWS.ask
 732                 State{..} <- composeLift RWS.get
 733                 let idNum = HM.lookupDefault (Nat1 1) pageRef_path state_pageRef
 734                 composeLift $ RWS.modify $ \s -> s
 735                  { state_pageRef = HM.insert pageRef_path (succNat1 idNum) state_pageRef }
 736                 let href_at = attrify pageRef_path <>
 737                         maybe mempty (\at -> refIdent (identifyAt "" at Nothing)) pageRef_at
 738                 let ref = do
 739                         H.sup
 740                          ! HA.id (attrify  $ identifyPage "" pageRef_path $ Just idNum) $$ do
 741                                 "["::HTML5
 742                                 H.a ! HA.href (attrify pageRef_path) $$
 743                                         html5ify pageRef_path
 744                                 "]"
 745                 H.span ! HA.class_ "page-ref" $$ do
 746                         H.a ! HA.href href_at $$
 747                                 html5ify pageRef_at
 748                         H.span ! HA.class_ "print-only" $$ do
 749                                 " "::HTML5
 750                                 ref
 751         -- <iref>
 752          PlainIref{..} ->
 753                 case pathFromWords iref_term of
 754                  Nothing -> html5ify ps
 755                  Just path -> do
 756                         Reader{reader_all=Analyze.All{..}} <- composeLift RWS.ask
 757                         State{state_irefs} <- composeLift RWS.get
 758                         let num = Strict.fromMaybe (Nat1 1) $ TM.lookup path state_irefs
 759                         composeLift $ RWS.modify $ \s -> s
 760                          { state_irefs = TM.insert const path (succNat1 num) state_irefs }
 761                         H.span ! HA.class_ "iref"
 762                                ! HA.id (attrify $ identifyIref iref_term $ Just num) $$
 763                                 html5ify ps
 764 instance Html5ify [Title] where
 765         html5ify =
 766                 html5ify . fold . List.intersperse sep . toList
 767                 where sep = Title $ Seq.singleton $ tree0 $ PlainText " — "
 768 instance Html5ify Title where
 769         html5ify (Title t) = html5ify t
 770 instance Html5ify About where
 771         html5ify About{..} = do
 772                 Loqualization l10n <- composeLift $ RWS.asks reader_l10n
 773                 H.p $$
 774                         html5CommasDot $ concat
 775                          [ html5Titles about_titles
 776                          , html5ify <$> about_authors
 777                          , html5ify <$> about_dates
 778                          , html5ify <$> about_series
 779                          ]
 780                 forM_ about_links $ \Link{..} ->
 781                         case () of
 782                          _ | link_rel == ""
 783                           || link_rel == "self" ->
 784                                 H.p ! HA.class_ "reference-url print-only" $$ do
 785                                         html5ify $ Tree PlainEref{eref_href=link_url} link_plain
 786                          _ ->
 787                                 H.p ! HA.class_ "reference-url" $$ do
 788                                         html5ify link_role
 789                                         Plain.l10n_Colon l10n :: HTML5
 790                                         html5ify $ Tree PlainEref{eref_href=link_url} link_plain
 791                 forM_ about_description $ \description -> do
 792                         H.div ! HA.class_ "reference-description" $$ do
 793                                 html5ify description
 794                 where
 795                 html5Titles :: [Title] -> [HTML5]
 796                 html5Titles ts | null ts = []
 797                 html5Titles ts = [html5Title $ joinTitles ts]
 798                         where
 799                         joinTitles = fold . List.intersperse sep . toList
 800                         sep = Title $ Seq.singleton $ tree0 $ PlainText " — "
 801                 html5Title (Title title) = do
 802                         H.span ! HA.class_ "no-print" $$
 803                                 html5ify $ Tree PlainQ $
 804                                         case List.filter ((\rel -> rel == "" || rel == "self") . link_rel) about_links of
 805                                          [] -> title
 806                                          Link{..}:_ -> pure $ Tree (PlainEref link_url) title
 807                         H.span ! HA.class_ "print-only" $$
 808                                 html5ify $ Tree PlainQ title
 809 instance Html5ify Serie where
 810         html5ify s@Serie{..} = do
 811                 Loqualization l10n <- composeLift $ RWS.asks reader_l10n
 812                 case urlSerie s of
 813                  Nothing -> do
 814                         html5ify serie_name
 815                         Plain.l10n_Colon l10n :: HTML5
 816                         html5ify serie_id
 817                  Just href -> do
 818                         html5ify $
 819                                 Tree PlainEref{eref_href=href} $
 820                                 Seq.fromList
 821                                  [ tree0 $ PlainText $ unName serie_name
 822                                  , tree0 $ PlainText $ Plain.l10n_Colon l10n
 823                                  , tree0 $ PlainText serie_id
 824                                  ]
 825 instance Html5ify Entity where
 826         html5ify Entity{..} = do
 827                 case () of
 828                  _ | not (TL.null entity_email) -> do
 829                         H.span ! HA.class_ "no-print" $$ do
 830                                 html5ify $
 831                                         Tree (PlainEref $ URL $ "mailto:"<>entity_email) $
 832                                                 pure $ tree0 $ PlainText entity_name
 833                                 html5ify $ orgs entity_org
 834                         H.span ! HA.class_ "print-only" $$
 835                                 html5ify $
 836                                         Tree (PlainEref $ URL entity_email) $
 837                                                 pure $ tree0 $ PlainText $
 838                                                         entity_name <> orgs entity_org
 839                         where
 840                         orgs = foldMap $ \Entity{entity_name=name, entity_org=org} -> " ("<>name<>orgs org<>")"
 841                  _ | Just u <- entity_url ->
 842                         html5ify $
 843                                 Tree (PlainEref u) $
 844                                         pure $ tree0 $ PlainText entity_name
 845                  _ ->
 846                         html5ify $
 847                                 tree0 $ PlainText entity_name
 848 instance Html5ify Words where
 849         html5ify = html5ify . Analyze.plainifyWords
 850 instance Html5ify Alias where
 851         html5ify Alias{..} = do
 852                 Reader{reader_all=Analyze.All{..}} <- composeLift RWS.ask
 853                 let mayId =
 854                         case attrs_id alias_attrs of
 855                          Just ident | Just [_] <- toList <$> HM.lookup ident all_section ->
 856                                 Just $ identifyTag "" ident Nothing
 857                          _ -> Nothing
 858                 H.a ! HA.class_ "alias"
 859                     !?? mayAttr HA.id mayId $$
 860                         mempty
 861 instance Html5ify URL where
 862         html5ify (URL url) =
 863                 H.a ! HA.class_ "url"
 864                     ! HA.href (attrify url) $$
 865                         html5ify url
 866 instance Html5ify Date where
 867         html5ify date@Date{..} = do
 868                 Loqualization l10n <- composeLift $ RWS.asks reader_l10n
 869                 case (date_rel, date_role) of
 870                  ("", "") -> ""::HTML5
 871                  (_, "") -> do
 872                         html5ify date_rel
 873                         Plain.l10n_Colon l10n
 874                  _ -> do
 875                         html5ify date_role
 876                         Plain.l10n_Colon l10n
 877                 Plain.l10n_Date date l10n
 878 instance Html5ify Reference where
 879         html5ify Reference{..} = do
 880                 Reader{reader_all=Analyze.All{..}} <- composeLift RWS.ask
 881                 State{state_errors=errs@Analyze.Errors{..}, ..} <- composeLift RWS.get
 882                 H.tr $$ do
 883                         H.td ! HA.class_ "reference-key" $$ do
 884                                 "["::HTML5
 885                                 case HM.lookup reference_id errors_reference_ambiguous of
 886                                  Nothing ->
 887                                         H.a ! HA.class_ "reference"
 888                                             ! HA.href (refIdent $ identifyReference "" reference_id Nothing)
 889                                             ! HA.id   (attrify  $ identifyReference "" reference_id Nothing) $$
 890                                                 html5ify reference_id
 891                                  Just errNum -> do
 892                                         composeLift $ RWS.modify $ \s -> s
 893                                          { state_errors = errs
 894                                                  { Analyze.errors_reference_ambiguous =
 895                                                         HM.insert reference_id (succNat1 errNum) errors_reference_ambiguous } }
 896                                         H.span ! HA.class_ "reference reference-ambiguous"
 897                                                ! HA.id (attrify $ identifyReference "-ambiguous" reference_id $ Just errNum) $$
 898                                                 html5ify reference_id
 899                                 "]"
 900                         H.td ! HA.class_ "reference-content" $$ do
 901                                 html5ify reference_about
 902                                 case HM.lookup reference_id all_ref of
 903                                  Nothing -> pure ()
 904                                  Just anchs ->
 905                                         when (isNothing $ HM.lookup reference_id errors_reference_ambiguous) $ do
 906                                                 H.p ! HA.class_ "ref-backs" $$
 907                                                         html5CommasDot $
 908                                                         (<$> List.zip (toList anchs) [1..]) $ \((_loc, maySection),num) ->
 909                                                                 H.a ! HA.class_ "ref-back"
 910                                                                     ! HA.href (refIdent $ identifyReference "" reference_id $ Just $ Nat1 num) $$
 911                                                                         html5SectionNumber maySection
 912 instance Html5ify XML.Ancestors where
 913         html5ify ancs =
 914                 case toList ancs of
 915                  [(_n,c)] -> do
 916                         html5ify $ show c
 917                         html5ify '.'
 918                  as ->
 919                         html5ify $
 920                                 Text.intercalate "." $
 921                                 Text.pack . show . snd <$> as
 922 instance Html5ify Plain.Plain where
 923         html5ify p = do
 924                 rp <- composeLift $ RWS.asks reader_plainify
 925                 html5ify $ Plain.runPlain p rp
 926 instance Html5ify TCT.Location where
 927         html5ify = \case
 928          s:|[] ->
 929                 H.span ! HA.class_ "tct-location" $$
 930                         html5ify $ show s
 931          ss -> do
 932                 H.ul ! HA.class_ "tct-location" $$
 933                         forM_ ss $ \s ->
 934                                 H.li $$
 935                                         html5ify $ show s
 936 {-
 937 instance Html5ify SVG.Element where
 938         html5ify svg =
 939                 html5ify $
 940                 B.preEscapedLazyText $
 941                 SVG.renderText svg
 942 instance Semigroup SVG.Element where
 943         (<>) = mappend
 944 -}
 945
 946 html5Commas :: [HTML5] -> HTML5
 947 html5Commas [] = pure ()
 948 html5Commas hs = do
 949         sequence_ $ List.intersperse ", " hs
 950
 951 html5CommasDot :: [HTML5] -> HTML5
 952 html5CommasDot [] = pure ()
 953 html5CommasDot hs = do
 954         html5Commas hs
 955         "."
 956
 957 html5Lines :: [HTML5] -> HTML5
 958 html5Lines hs = sequence_ $ List.intersperse (html5ify H.br) hs
 959
 960 html5Words :: [HTML5] -> HTML5
 961 html5Words hs = sequence_ $ List.intersperse " " hs
 962
 963 html5SectionAnchor :: Section -> HTML5
 964 html5SectionAnchor = go mempty . XML.pos_ancestors . section_posXML
 965         where
 966         go :: XML.Ancestors -> XML.Ancestors -> HTML5
 967         go prev next =
 968                 case Seq.viewl next of
 969                  Seq.EmptyL -> pure ()
 970                  a@(_n,rank) Seq.:< as -> do
 971                         H.a ! HA.href (refIdent $ identify $ prev Seq.|> a) $$
 972                                 html5ify $ show rank
 973                         when (not (null as) || null prev) $ do
 974                                 html5ify '.'
 975                                 go (prev Seq.|>a) as
 976
 977 html5SectionTo :: Section -> HTML5
 978 html5SectionTo Section{..} =
 979         H.a ! HA.href (refIdent $ identify ancestors) $$
 980                 html5ify ancestors
 981         where ancestors = XML.pos_ancestors section_posXML
 982
 983 html5SectionNumber :: Section -> HTML5
 984 html5SectionNumber Section{..} =
 985         html5ify $ XML.pos_ancestors section_posXML
 986
 987 popNotes :: ComposeRWS Reader Writer State H.MarkupM (Seq [Para])
 988 popNotes = do
 989         st <- composeLift RWS.get
 990         case {-debug "state_notes" $-} state_notes st of
 991          [] -> return mempty
 992          curr:next -> do
 993                 composeLift $ RWS.modify $ \s -> s{state_notes=next}
 994                 return curr
 995
 996 html5Notes :: Seq [Para] -> HTML5
 997 html5Notes notes = do
 998         unless (null notes) $ do
 999                 H.aside ! HA.class_ "notes" $$ do
1000                         Compose $ pure H.hr
1001                         H.table $$
1002                                 H.tbody $$
1003                                         forM_ notes $ \content -> do
1004                                                 num <- composeLift $ do
1005                                                         n <- RWS.gets state_note_num_content
1006                                                         RWS.modify $ \s -> s{state_note_num_content=succNat1 n}
1007                                                         return n
1008                                                 H.tr $$ do
1009                                                         H.td ! HA.class_ "note-ref" $$ do
1010                                                                 H.a ! HA.class_ "note-number"
1011                                                                     ! HA.id   ("note."<>attrify num)
1012                                                                     ! HA.href ("#note."<>attrify num) $$ do
1013                                                                         html5ify num
1014                                                                 ". "::HTML5
1015                                                                 H.a ! HA.href ("#note-ref."<>attrify num) $$ do
1016                                                                         "↑"
1017                                                         H.td $$
1018                                                                 html5ify content
1019
1020 html5ifyToC :: Maybe DTC.Nat -> Tree BodyNode -> HTML5
1021 html5ifyToC depth (Tree b bs) =
1022         case b of
1023          BodySection section@Section{section_about=About{..}, ..} -> do
1024                 H.li $$ do
1025                         H.table ! HA.class_ "toc-entry" $$
1026                                 H.tbody $$
1027                                         case about_titles of
1028                                          [] ->
1029                                                 H.tr $$ do
1030                                                         H.td ! HA.class_ "section-number" $$
1031                                                                 html5SectionTo section
1032                                          title:titles -> do
1033                                                 H.tr $$ do
1034                                                         H.td ! HA.class_ "section-number" $$
1035                                                                 html5SectionTo section
1036                                                         H.td ! HA.class_ "section-title" $$
1037                                                                 html5ify $ cleanPlain $ unTitle title
1038                                                 forM_ titles $ \t ->
1039                                                         H.tr $$ do
1040                                                                 H.td ! HA.class_ "section-title" $$
1041                                                                         html5ify $ cleanPlain $ unTitle t
1042                         when (maybe True (> Nat 1) depth && not (null sections)) $
1043                                 H.ul $$
1044                                         forM_ sections $
1045                                                 html5ifyToC (depth >>= predNat)
1046          _ -> mempty
1047         where
1048         sections =
1049                 (`Seq.filter` bs) $ \case
1050                  Tree BodySection{} _ -> True
1051                  _ -> False
1052
1053 html5ifyToF :: [TL.Text] -> HTML5
1054 html5ifyToF types = do
1055         figuresByType <- composeLift $ RWS.asks $ Analyze.all_figure . reader_all
1056         let figures =
1057                 Map.unions $
1058                 ((\(ty,ts) -> (ty,) <$> ts) <$>) $
1059                 HM.toList $
1060                 if null types
1061                 then figuresByType
1062                 else
1063                         HM.intersection figuresByType $
1064                         HM.fromList [(ty,()) | ty <- types]
1065         forM_ (Map.toList figures) $ \(posXML, (type_, title)) ->
1066                 H.tr $$ do
1067                         H.td ! HA.class_ "figure-number" $$
1068                                 H.a ! HA.href (refIdent $ identify posXML) $$ do
1069                                         html5ify type_
1070                                         html5ify $ XML.pos_ancestors posXML
1071                         forM_ title $ \ti ->
1072                                 H.td ! HA.class_ "figure-title" $$
1073                                         html5ify $ cleanPlain $ unTitle ti
1074
1075 -- 'Attrify'
1076 instance Attrify Plain.Plain where
1077         attrify p = attrify $ Plain.runPlain p def