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