Language/DTC/Write/HTML5.hs

   1 {-# LANGUAGE DuplicateRecordFields #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE FlexibleContexts #-}
   4 {-# LANGUAGE MultiParamTypeClasses #-}
   5 {-# LANGUAGE OverloadedStrings #-}
   6 {-# LANGUAGE ScopedTypeVariables #-}
   7 {-# LANGUAGE TypeApplications #-}
   8 {-# OPTIONS_GHC -fno-warn-orphans #-}
   9 module Language.DTC.Write.HTML5 where
  10
  11 import Control.Applicative (Applicative(..))
  12 import Control.Category as Cat
  13 import Control.Monad
  14 import Data.Bool
  15 import Data.Char (Char)
  16 import Data.Default.Class (Default(..))
  17 import Data.Foldable (Foldable(..), concat)
  18 import Data.Function (($), const, flip, on)
  19 import Data.Functor (Functor(..), (<$>))
  20 import Data.Functor.Compose (Compose(..))
  21 import Data.Int (Int)
  22 import Data.Map.Strict (Map)
  23 import Data.Maybe (Maybe(..), maybe, mapMaybe, fromJust, maybeToList)
  24 import Data.Monoid (Monoid(..))
  25 import Data.Ord (Ord(..))
  26 import Data.Semigroup (Semigroup(..))
  27 import Data.String (String, IsString(..))
  28 import Data.Text (Text)
  29 import Data.TreeSeq.Strict (Tree(..), tree0)
  30 import Data.Tuple (snd)
  31 import System.FilePath (FilePath)
  32 import Text.Blaze ((!))
  33 import Text.Blaze.Html (Html)
  34 import Text.Show (Show(..))
  35 import qualified Control.Monad.Trans.State as S
  36 import qualified Data.Char as Char
  37 import qualified Data.List as List
  38 import qualified Data.Map.Strict as Map
  39 import qualified Data.Sequence as Seq
  40 import qualified Data.Strict.Maybe as Strict
  41 import qualified Data.Text as Text
  42 import qualified Data.Text.Lazy as TL
  43 import qualified Data.TreeMap.Strict as TreeMap
  44 import qualified Data.TreeSeq.Strict.Zipper as Tree
  45 import qualified Text.Blaze.Html5 as H
  46 import qualified Text.Blaze.Html5.Attributes  as HA
  47 import qualified Text.Blaze.Internal as H
  48
  49 import Text.Blaze.Utils
  50 import Data.Locale hiding (Index)
  51 import qualified Data.Locale as Locale
  52
  53 import Language.DTC.Write.XML ()
  54 import Language.DTC.Write.Plain (Plainify(..))
  55 import qualified Language.DTC.Write.Plain as Plain
  56 import Language.DTC.Document as DTC
  57 import qualified Language.DTC.Anchor as Anchor
  58
  59 document ::
  60  Localize locales Plain.Plain Plain.L10n =>
  61  Locales  locales =>
  62  LocaleIn locales -> DTC.Document -> Html
  63 document locale DTC.Document{..} = do
  64         let Keys{..} = keys body `S.execState` def
  65         let (body',state_rrefs,state_notes,state_indexs) =
  66                 let irefs = foldMap Anchor.irefsOfTerms keys_index in
  67                 let (body0, Anchor.State{state_irefs, state_rrefs=rrefs, state_notes=notes}) =
  68                         Anchor.anchorify body `S.runState`
  69                         def{Anchor.state_irefs=irefs} in
  70                 (body0,rrefs,notes,) $
  71                 (<$> keys_index) $ \terms ->
  72                         (terms,) $
  73                         TreeMap.intersection const state_irefs $
  74                         Anchor.irefsOfTerms terms
  75         let state_plainify = def
  76                 { Plain.state_localize = Locale.localize locale }
  77         let (html5Body, State{state_styles,state_scripts}) =
  78                 runStateMarkup def
  79                  { state_indexs
  80                  , state_rrefs
  81                  , state_notes
  82                  , state_figures    = keys_figure
  83                  , state_references = keys_reference
  84                  , state_plainify
  85                  } $ html5ify body'
  86
  87         H.docType
  88         H.html ! HA.lang (attrify $ countryCode locale) $ do
  89                 H.head $ do
  90                         H.meta ! HA.httpEquiv "Content-Type"
  91                                ! HA.content "text/html; charset=UTF-8"
  92                         whenSome (DTC.titles $ DTC.about (head :: Head)) $ \ts ->
  93                                 H.title $
  94                                         H.toMarkup $ Plain.text state_plainify $ List.head ts
  95                         forM_ (DTC.links $ DTC.about (head :: Head)) $ \Link{rel, href} ->
  96                                 H.link ! HA.rel (attrify rel)
  97                                        ! HA.href (attrify href)
  98                         H.meta ! HA.name "generator"
  99                                ! HA.content "https://hackage.haskell.org/package/hdoc"
 100                         let chapters =
 101                                 (`mapMaybe` toList body) $ \case
 102                                  Tree k@BodySection{} _ -> Just k
 103                                  _ -> Nothing
 104                         forM_ chapters $ \case
 105                          BodySection{..} ->
 106                                 H.link ! HA.rel "Chapter"
 107                                        ! HA.title (attrify $ plainify title)
 108                                        ! HA.href ("#"<>attrify pos)
 109                          _ -> mempty
 110                         H.link ! HA.rel "stylesheet"
 111                                ! HA.type_ "text/css"
 112                                ! HA.href "style/dtc-html5.css"
 113                         forM_ state_styles $ \style ->
 114                                 H.style ! HA.type_ "text/css" $
 115                                         H.toMarkup style
 116                         forM_ state_scripts $ \script ->
 117                                 H.script ! HA.type_ "application/javascript" $
 118                                         H.toMarkup script
 119                 H.body
 120                         html5Body
 121
 122 (<&>) :: Functor f => f a -> (a -> b) -> f b
 123 (<&>) = flip (<$>)
 124 infixl 4 <&>
 125
 126 -- * Type 'Html5'
 127 type Html5 = StateMarkup State ()
 128 instance IsString Html5 where
 129         fromString = html5ify
 130
 131 -- * Type 'State'
 132 data State
 133  =   State
 134  {   state_styles     :: Map FilePath CSS
 135  ,   state_scripts    :: Map FilePath Script
 136  ,   state_indexs     :: Map DTC.Pos (Terms, Anchor.Irefs)
 137  ,   state_rrefs      :: Anchor.Rrefs
 138  ,   state_figures    :: Map TL.Text (Map DTC.Pos (Maybe Title))
 139  ,   state_references :: Map Ident About
 140  ,   state_notes      :: Anchor.Notes
 141  ,   state_plainify   :: Plain.State
 142  }
 143 instance Default State where
 144         def = State
 145          { state_styles     = def
 146          , state_scripts    = def
 147          , state_indexs     = def
 148          , state_rrefs      = def
 149          , state_figures    = def
 150          , state_references = def
 151          , state_notes      = def
 152          , state_plainify   = def
 153          }
 154 type CSS = Text
 155 type Script = Text
 156
 157 -- * Type 'Keys'
 158 data Keys
 159  = Keys
 160  { keys_index     :: Map DTC.Pos Terms
 161  , keys_figure    :: Map TL.Text (Map DTC.Pos (Maybe Title))
 162  , keys_reference :: Map Ident About
 163  } deriving (Show)
 164 instance Default Keys where
 165         def = Keys mempty mempty mempty
 166
 167 -- ** Class 'KeysOf'
 168 class KeysOf a where
 169         keys :: a -> S.State Keys ()
 170 instance KeysOf Body where
 171         keys = mapM_ keys
 172 instance KeysOf (Tree BodyNode) where
 173         keys (Tree n ts) =
 174                 case n of
 175                  BodySection{..} -> keys ts
 176                  BodyBlock b -> keys b
 177 instance KeysOf DTC.Block where
 178         keys = \case
 179          BlockPara{} -> return ()
 180          BlockToC{}  -> return ()
 181          BlockToF{}  -> return ()
 182          BlockIndex{..} ->
 183                 S.modify $ \s -> s{keys_index=
 184                         Map.insert pos terms $ keys_index s}
 185          BlockFigure{..} ->
 186                 S.modify $ \s -> s{keys_figure=
 187                         Map.insertWith (<>)
 188                          type_ (Map.singleton pos mayTitle) $
 189                         keys_figure s}
 190          BlockReferences{..} ->
 191                 S.modify $ \s -> s{keys_reference=
 192                         foldr
 193                          (\r -> Map.insert
 194                                  (DTC.id    (r::DTC.Reference))
 195                                  (DTC.about (r::DTC.Reference)))
 196                          (keys_reference s)
 197                          refs}
 198
 199 -- * Class 'Html5ify'
 200 class Html5ify a where
 201         html5ify :: a -> Html5
 202 instance Html5ify H.Markup where
 203         html5ify = Compose . return
 204 instance Html5ify Char where
 205         html5ify = html5ify . H.toMarkup
 206 instance Html5ify Text where
 207         html5ify = html5ify . H.toMarkup
 208 instance Html5ify TL.Text where
 209         html5ify = html5ify . H.toMarkup
 210 instance Html5ify String where
 211         html5ify = html5ify . H.toMarkup
 212 instance Html5ify Title where
 213         html5ify (Title t) = html5ify t
 214 instance Html5ify Ident where
 215         html5ify (Ident i) = html5ify i
 216 instance Html5ify Int where
 217         html5ify = html5ify . show
 218 instance Html5ify Nat where
 219         html5ify (Nat n) = html5ify n
 220 instance Html5ify Nat1 where
 221         html5ify (Nat1 n) = html5ify n
 222 instance Html5ify a => Html5ify (Maybe a) where
 223         html5ify = foldMap html5ify
 224
 225 -- * Type 'BodyCursor'
 226 -- | Cursor to navigate within a 'Body' according to many axis (like in XSLT).
 227 type BodyCursor = Tree.Zipper BodyNode
 228 instance Html5ify Body where
 229         html5ify body =
 230                 forM_ (Tree.zippers body) $ \z ->
 231                         forM_ (Tree.axis_repeat Tree.axis_following_sibling_nearest `Tree.runAxis` z) $
 232                                 html5ify
 233 instance Html5ify BodyCursor
 234  where html5ify z =
 235         let Tree n _ts = Tree.current z in
 236         case n of
 237          BodyBlock BlockToC{..} -> do
 238                 H.nav ! HA.class_ "toc"
 239                       ! HA.id (attrify pos) $$ do
 240                         H.span ! HA.class_ "toc-name" $$
 241                                 H.a ! HA.href (attrify pos) $$
 242                                         html5ify Plain.L10n_Table_of_Contents
 243                         H.ul $$
 244                                 forM_ (Tree.axis_following_sibling `Tree.runAxis` z) $
 245                                         html5ifyToC depth
 246          BodyBlock b -> html5ify b
 247          BodySection{..} -> do
 248                 do
 249                         notes <- liftStateMarkup $ S.gets state_notes
 250                         let mayNotes = do
 251                                 p <- posParent $ posAncestors pos
 252                                 let (ns, as) = Map.updateLookupWithKey (\_ _ -> Nothing) p notes
 253                                 (,as) <$> ns
 254                         case mayNotes of
 255                          Nothing -> mempty
 256                          Just (secNotes, state_notes) -> do
 257                                 liftStateMarkup $ S.modify' $ \s -> s{state_notes}
 258                                 html5ify secNotes
 259                 H.section ! HA.class_ "section"
 260                           ! HA.id (attrify pos) $$ do
 261                         forM_ aliases html5ify
 262                         html5CommonAttrs attrs{classes="section-header":classes attrs} $
 263                                 H.table $$
 264                                         H.tbody $$
 265                                                 H.tr $$ do
 266                                                         H.td ! HA.class_ "section-number" $$ do
 267                                                                 html5SectionNumber $ DTC.posAncestors pos
 268                                                         H.td ! HA.class_ "section-title" $$ do
 269                                                                 (case List.length $ DTC.posAncestors pos of
 270                                                                  0 -> H.h1
 271                                                                  1 -> H.h2
 272                                                                  2 -> H.h3
 273                                                                  3 -> H.h4
 274                                                                  4 -> H.h5
 275                                                                  5 -> H.h6
 276                                                                  _ -> H.h6) $$
 277                                                                         html5ify title
 278                         forM_ (Tree.axis_child `Tree.runAxis` z) $
 279                                 html5ify
 280                         notes <- liftStateMarkup $ S.gets state_notes
 281                         html5ify $ Map.lookup (posAncestors pos) notes
 282 instance Html5ify [Anchor.Note] where
 283         html5ify notes =
 284                 H.aside ! HA.class_ "notes" $$ do
 285                         Compose $ pure H.hr
 286                         H.table $$
 287                                 H.tbody $$
 288                                         forM_ (List.reverse notes) $ \Anchor.Note{..} ->
 289                                                 H.tr $$ do
 290                                                         H.td ! HA.class_ "note-ref" $$ do
 291                                                                 H.a ! HA.class_ "note-number"
 292                                                                     ! HA.id   ("note."<>attrify note_number)
 293                                                                     ! HA.href ("#note."<>attrify note_number) $$ do
 294                                                                         html5ify note_number
 295                                                                 ". "::Html5
 296                                                                 H.a ! HA.href ("#note-ref."<>attrify note_number) $$ do
 297                                                                         "↑"
 298                                                         H.td $$
 299                                                                 html5ify note_content
 300 instance Html5ify Block where
 301         html5ify = \case
 302          BlockPara para -> html5ify para
 303          BlockToC{..} -> mempty -- NOTE: done in Html5ify BodyCursor
 304          BlockToF{..} -> do
 305                 H.nav ! HA.class_ "tof"
 306                       ! HA.id (attrify pos) $$
 307                         H.table ! HA.class_ "tof" $$
 308                                 H.tbody $$
 309                                         html5ifyToF types
 310          BlockFigure{..} ->
 311                 html5CommonAttrs attrs
 312                  { classes = "figure":("figure-"<>type_):classes attrs
 313                  , DTC.id  = Just $ Ident $ Plain.text def $ DTC.posAncestors pos
 314                  } $
 315                 H.div $$ do
 316                         H.table ! HA.class_ "figure-caption" $$
 317                                 H.tbody $$
 318                                         H.tr $$ do
 319                                                 if TL.null type_
 320                                                  then H.a ! HA.href ("#"<>attrify pos) $$ mempty
 321                                                  else
 322                                                         H.td ! HA.class_ "figure-number" $$ do
 323                                                                 H.a ! HA.href ("#"<>attrify pos) $$ do
 324                                                                         html5ify type_
 325                                                                         html5ify $ DTC.posAncestors pos
 326                                                 forM_ mayTitle $ \title ->
 327                                                         H.td ! HA.class_ "figure-title" $$ do
 328                                                                 unless (TL.null type_) $
 329                                                                         html5ify $ Plain.L10n_Colon
 330                                                                 html5ify title
 331                         H.div ! HA.class_ "figure-content" $$ do
 332                                 html5ify paras
 333          BlockIndex{pos} -> do
 334                 (allTerms,refsByTerm) <- liftStateMarkup $ S.gets $ (Map.! pos) . state_indexs
 335                 let chars = Anchor.termsByChar allTerms
 336                 H.div ! HA.class_ "index"
 337                       ! HA.id (attrify pos) $$ do
 338                         H.nav ! HA.class_ "index-nav" $$ do
 339                                 forM_ (Map.keys chars) $ \char ->
 340                                         H.a ! HA.href ("#"<>(attrify pos <> "." <> attrify char)) $$
 341                                                 html5ify char
 342                         H.dl ! HA.class_ "index-chars" $$
 343                                 forM_ (Map.toList chars) $ \(char,terms) -> do
 344                                         H.dt $$
 345                                                 let i = attrify pos <> "." <> attrify char in
 346                                                 H.a ! HA.id i
 347                                                     ! HA.href ("#"<>i) $$
 348                                                         html5ify char
 349                                         H.dd $$
 350                                                 H.dl ! HA.class_ "index-term" $$ do
 351                                                 forM_ terms $ \aliases -> do
 352                                                         H.dt $$
 353                                                                 H.ul ! HA.class_ "index-aliases" $$
 354                                                                         forM_ (List.take 1 aliases) $ \term ->
 355                                                                                 H.li ! HA.id (attrifyIref term) $$
 356                                                                                         html5ify term
 357                                                         H.dd $$
 358                                                                 let anchs =
 359                                                                         List.sortBy (compare `on` DTC.section . snd) $
 360                                                                         (`foldMap` aliases) $ \words ->
 361                                                                                 fromJust $ do
 362                                                                                         path <- Anchor.pathFromWords words
 363                                                                                         Strict.maybe Nothing (Just . ((words,) <$>) . List.reverse) $
 364                                                                                                 TreeMap.lookup path refsByTerm in
 365                                                                 html5CommasDot $
 366                                                                 (<$> anchs) $ \(term,DTC.Anchor{..}) ->
 367                                                                         H.a ! HA.class_ "index-iref"
 368                                                                             ! HA.href ("#"<>attrifyIrefCount term count) $$
 369                                                                                 html5ify $ DTC.posAncestors section
 370          BlockReferences{..} ->
 371                 html5CommonAttrs attrs
 372                  { classes = "references":classes attrs
 373                  , DTC.id  = Just $ Ident $ Plain.text def $ DTC.posAncestors pos
 374                  } $
 375                 H.div $$ do
 376                         H.table $$
 377                                 forM_ refs html5ify
 378
 379 html5ifyToC :: Maybe DTC.Nat -> BodyCursor -> Html5
 380 html5ifyToC depth z =
 381         let Tree n _ts = Tree.current z in
 382         case n of
 383          BodySection{..} -> do
 384                 H.li $$ do
 385                         H.table ! HA.class_ "toc-entry" $$
 386                                 H.tbody $$
 387                                         H.tr $$ do
 388                                                 H.td ! HA.class_ "section-number" $$
 389                                                         html5SectionRef $ DTC.posAncestors pos
 390                                                 H.td ! HA.class_ "section-title" $$
 391                                                         html5ify $ cleanPlain $ unTitle title
 392                         when (maybe True (> Nat 1) depth && not (null sections)) $
 393                                 H.ul $$
 394                                         forM_ sections $
 395                                                 html5ifyToC (depth >>= predNat)
 396          _ -> pure ()
 397         where
 398         sections =
 399                 (`Tree.runAxis` z) $
 400                 Tree.axis_child
 401                 `Tree.axis_filter_current` \case
 402                  Tree BodySection{} _ -> True
 403                  _ -> False
 404
 405 html5ifyToF :: [TL.Text] -> Html5
 406 html5ifyToF types = do
 407         figsByType <- liftStateMarkup $ S.gets state_figures
 408         let figs =
 409                 Map.foldMapWithKey (\ty -> ((ty,) <$>)) $
 410                 if null types
 411                 then figsByType
 412                 else
 413                         Map.intersection figsByType $
 414                         Map.fromList [(ty,()) | ty <- types]
 415         forM_ (Map.toList figs) $ \(pos, (type_, title)) ->
 416                 H.tr $$ do
 417                         H.td ! HA.class_ "figure-number" $$
 418                                 H.a ! HA.href ("#"<>attrify pos) $$ do
 419                                         html5ify type_
 420                                         html5ify $ DTC.posAncestors pos
 421                         forM_ title $ \ti ->
 422                                 H.td ! HA.class_ "figure-title" $$
 423                                         html5ify $ cleanPlain $ unTitle ti
 424
 425 cleanPlain :: Plain -> Plain
 426 cleanPlain ps =
 427         ps >>= \case
 428          Tree PlainIref{} ls -> cleanPlain ls
 429          Tree PlainNote{} _  -> mempty
 430          Tree n ts -> pure $ Tree n $ cleanPlain ts
 431
 432 instance Html5ify Para where
 433         html5ify = \case
 434          ParaItem{..} ->
 435                 html5CommonAttrs def
 436                  { classes="para":cls item
 437                  } $
 438                         html5ify item
 439          ParaItems{..} ->
 440                 html5CommonAttrs attrs
 441                  { classes = "para":classes attrs
 442                  , DTC.id  = id_ pos
 443                  } $
 444                 H.div $$
 445                         forM_ items $ \item ->
 446                                 html5AttrClass (cls item) $
 447                                 html5ify item
 448          where
 449                 id_ = Just . Ident . Plain.text def . DTC.posAncestors
 450                 cls = \case
 451                  ParaPlain{}     -> []
 452                  ParaArtwork{..} -> ["artwork", "artwork-"<>type_]
 453                  ParaQuote{..}   -> ["quote", "quote-"<>type_]
 454                  ParaComment{}   -> []
 455                  ParaOL{}        -> ["ol"]
 456                  ParaUL{}        -> ["ul"]
 457 instance Html5ify ParaItem where
 458         html5ify = \case
 459          ParaPlain p -> H.p $$ html5ify p
 460          ParaArtwork{..} -> H.pre $$ do html5ify text
 461          ParaQuote{..} -> H.div $$ do html5ify paras
 462          ParaComment t -> html5ify $ H.Comment (H.String $ TL.unpack t) ()
 463          ParaOL items ->
 464                 H.table $$ do
 465                         H.tbody $$
 466                                 forM_ items $ \ListItem{..} -> do
 467                                         H.tr $$ do
 468                                                 H.td ! HA.class_ "name" $$ do
 469                                                         html5ify name
 470                                                         "."::Html5
 471                                                 H.td ! HA.class_ "value" $$
 472                                                         html5ify paras
 473          ParaUL items ->
 474                 H.dl $$ do
 475                         forM_ items $ \item -> do
 476                                 H.dt $$ "—"
 477                                 H.dd $$ html5ify item
 478 instance Html5ify [Para] where
 479         html5ify = mapM_ html5ify
 480
 481 instance Html5ify Plain where
 482         html5ify ps =
 483                 case Seq.viewl ps of
 484                  Seq.EmptyL -> mempty
 485                  curr Seq.:< next ->
 486                         case curr of
 487                         -- NOTE: gather adjacent PlainNotes
 488                          Tree PlainNote{} _
 489                           | (notes, rest) <- Seq.spanl (\case {Tree PlainNote{} _ -> True; _ -> False}) next -> do
 490                                 H.sup ! HA.class_ "note-numbers" $$ do
 491                                         html5ify curr
 492                                         forM_ notes $ \note -> do
 493                                                 ", "::Html5
 494                                                 html5ify note
 495                                 " "::Html5
 496                                 html5ify rest
 497                         --
 498                          _ -> do
 499                                 html5ify curr
 500                                 html5ify next
 501 instance Html5ify (Tree PlainNode)
 502  where html5ify (Tree n ls) =
 503         case n of
 504          PlainBR     -> html5ify H.br
 505          PlainText t -> html5ify t
 506          PlainGroup  -> html5ify ls
 507          PlainB      -> H.strong $$ html5ify ls
 508          PlainCode   -> H.code   $$ html5ify ls
 509          PlainDel    -> H.del    $$ html5ify ls
 510          PlainI -> do
 511                 i <- liftStateMarkup $ do
 512                         i <- S.gets $ Plain.state_italic . state_plainify
 513                         S.modify $ \s ->
 514                                 s{state_plainify=
 515                                         (state_plainify s){Plain.state_italic=
 516                                                 not i}}
 517                         return i
 518                 H.em ! HA.class_ (if i then "even" else "odd") $$
 519                         html5ify ls
 520                 liftStateMarkup $
 521                         S.modify $ \s ->
 522                                 s{state_plainify=
 523                                         (state_plainify s){Plain.state_italic=i}}
 524          PlainSub  -> H.sub    $$ html5ify ls
 525          PlainSup  -> H.sup    $$ html5ify ls
 526          PlainSC   -> H.span ! HA.class_ "smallcaps" $$ html5ify ls
 527          PlainU    -> H.span ! HA.class_ "underline" $$ html5ify ls
 528          PlainNote{..} ->
 529                 case number of
 530                  Nothing -> mempty
 531                  Just num ->
 532                         H.a ! HA.class_ "note-ref"
 533                             ! HA.id ("note-ref."<>attrify num)
 534                             ! HA.href ("#note."<>attrify num) $$
 535                                 html5ify num
 536          PlainQ -> do
 537                 depth <- liftStateMarkup $ do
 538                         depth <- S.gets $ Plain.state_quote . state_plainify
 539                         S.modify $ \s -> s{state_plainify=
 540                                 (state_plainify s){Plain.state_quote=
 541                                         succNat depth}}
 542                         return depth
 543                 H.span ! HA.class_ "q" $$ do
 544                         html5ify $ Plain.L10n_QuoteOpen depth
 545                         html5ify $ Tree PlainI ls
 546                         html5ify $ Plain.L10n_QuoteClose depth
 547                 liftStateMarkup $
 548                         S.modify $ \s ->
 549                                 s{state_plainify=
 550                                         (state_plainify s){Plain.state_quote = depth}}
 551          PlainEref{..} ->
 552                 H.a ! HA.class_ "eref"
 553                     ! HA.href (attrify href) $$
 554                         if null ls
 555                         then html5ify $ unURL href
 556                         else html5ify ls
 557          PlainIref{..} ->
 558                 case anchor of
 559                  Nothing -> html5ify ls
 560                  Just Anchor{..} ->
 561                         H.span ! HA.class_ "iref"
 562                                ! HA.id (attrifyIrefCount term count) $$
 563                                 html5ify ls
 564          PlainRef{..} ->
 565                 H.a ! HA.class_ "ref"
 566                     ! HA.href ("#"<>attrify to) $$
 567                 if null ls
 568                 then html5ify to
 569                 else html5ify ls
 570          PlainRref{..} -> do
 571                 refs <- liftStateMarkup $ S.gets state_references
 572                 case Map.lookup to refs of
 573                  Nothing -> do
 574                         "["::Html5
 575                         H.span ! HA.class_ "rref-broken" $$
 576                                 html5ify to
 577                         "]"
 578                  Just About{..} -> do
 579                         unless (null ls) $
 580                                 forM_ (List.take 1 titles) $ \(Title title) -> do
 581                                         html5ify $ Tree PlainQ $
 582                                                 case url of
 583                                                  Nothing -> title
 584                                                  Just u -> pure $ Tree (PlainEref u) title
 585                                         " "::Html5
 586                         "["::Html5
 587                         H.a ! HA.class_ "rref"
 588                             ! HA.href ("#rref."<>attrify to)
 589                             ! HA.id ("rref."<>attrify to<>maybe "" (\Anchor{..} -> "."<>attrify count) anchor) $$
 590                                 html5ify to
 591                         "]"
 592
 593 instance Html5ify About where
 594         html5ify About{..} =
 595                 html5CommasDot $ concat $
 596                  [ html5Titles titles
 597                  , html5Entity <$> authors
 598                  , html5ify    <$> maybeToList date
 599                  , html5Entity <$> maybeToList editor
 600                  , html5Serie  <$> series
 601                  ]
 602                 where
 603                 html5Titles :: [Title] -> [Html5]
 604                 html5Titles ts | null ts = []
 605                 html5Titles ts = [html5Title $ fold $ List.intersperse t $ toList ts]
 606                         where t = Title $ Seq.singleton $ tree0 $ PlainText " — "
 607                 html5Title (Title title) =
 608                         html5ify $ Tree PlainQ $
 609                                 case url of
 610                                  Nothing -> title
 611                                  Just u -> pure $ Tree (PlainEref u) title
 612                 html5SerieHref href Serie{..} = do
 613                         sp <- liftStateMarkup $ S.gets state_plainify
 614                         html5ify $
 615                                 Tree PlainEref{href} $
 616                                 Seq.fromList
 617                                  [ tree0 $ PlainText $ name
 618                                  , tree0 $ PlainText $ Plain.text sp Plain.L10n_Colon
 619                                  , tree0 $ PlainText key
 620                                  ]
 621                 html5Serie s@Serie{name="RFC", key} | TL.all Char.isDigit key =
 622                         html5SerieHref (URL $ "https://tools.ietf.org/html/rfc"<>key) s
 623                 html5Serie s@Serie{name="DOI", key} =
 624                         html5SerieHref (URL $ "https://dx.doi.org/"<>key) s
 625                 html5Serie Serie{..} = do
 626                         html5ify name
 627                         html5ify Plain.L10n_Colon
 628                         html5ify key
 629                 html5Entity Entity{url=mu, ..} = do
 630                         html5ify $
 631                                 case () of
 632                                  _ | not (TL.null email) ->
 633                                         Tree (PlainEref $ URL $ "mailto:"<>email) $
 634                                                 pure $ tree0 $ PlainText name
 635                                  _ | Just u <- mu ->
 636                                         Tree (PlainEref u) $
 637                                                 pure $ tree0 $ PlainText name
 638                                  _ -> tree0 $ PlainText name
 639                         forM_ org $ \o -> do
 640                                 " ("::Html5
 641                                 html5Entity o
 642                                 ")"::Html5
 643 instance Html5ify Words where
 644         html5ify = html5ify . Anchor.plainifyWords
 645 instance Html5ify Alias where
 646         html5ify Alias{id=id_, ..} = do
 647                 H.a ! HA.class_ "alias"
 648                     ! HA.id (attrify id_) $$
 649                         mempty
 650 instance Html5ify URL where
 651         html5ify (URL url) =
 652                 H.a ! HA.class_ "eref"
 653                     ! HA.href (attrify url) $$
 654                         html5ify url
 655 instance Html5ify Date where
 656         html5ify = html5ify . Plain.L10n_Date
 657 instance Html5ify Reference where
 658         html5ify Reference{id=id_, ..} =
 659                 H.tr $$ do
 660                         H.td ! HA.class_ "reference-key" $$
 661                                 html5ify $ Tree PlainRref{anchor=Nothing, to=id_} Seq.empty
 662                         H.td ! HA.class_ "reference-content" $$ do
 663                                 html5ify about
 664                                 rrefs <- liftStateMarkup $ S.gets state_rrefs
 665                                 case Map.lookup id_ rrefs of
 666                                  Nothing -> pure ()
 667                                  Just anchs ->
 668                                         H.span ! HA.class_ "reference-rrefs" $$
 669                                                 html5CommasDot $
 670                                                 (<$> List.reverse anchs) $ \Anchor{..} ->
 671                                                         H.a ! HA.class_ "reference-rref"
 672                                                             ! HA.href ("#rref."<>attrify id_<>"."<>attrify count) $$
 673                                                                 html5ify $ DTC.posAncestors section
 674 instance Html5ify PosPath where
 675         html5ify ancs =
 676                 case toList ancs of
 677                  [(_n,c)] -> do
 678                         html5ify $ show c
 679                         html5ify '.'
 680                  as ->
 681                         html5ify $
 682                                 Text.intercalate "." $
 683                                 Text.pack . show . snd <$> as
 684 instance Html5ify Plain.Plain where
 685         html5ify p = do
 686                 sp <- liftStateMarkup $ S.gets state_plainify
 687                 let (t,sp') = Plain.runPlain p sp
 688                 html5ify t
 689                 liftStateMarkup $ S.modify $ \s -> s{state_plainify=sp'}
 690
 691 html5CommasDot :: [Html5] -> Html5
 692 html5CommasDot [] = pure ()
 693 html5CommasDot hs = do
 694         sequence_ $ List.intersperse ", " hs
 695         "."
 696
 697 html5AttrClass :: [TL.Text] -> Html5 -> Html5
 698 html5AttrClass = \case
 699  [] -> Cat.id
 700  cls  ->
 701         Compose .
 702         (H.AddCustomAttribute "class"
 703          (H.String $ TL.unpack $ TL.unwords cls) <$>) .
 704         getCompose
 705
 706 html5AttrId :: Ident -> Html5 -> Html5
 707 html5AttrId (Ident id_) =
 708         Compose .
 709         (H.AddCustomAttribute "id"
 710          (H.String $ TL.unpack id_) <$>) .
 711         getCompose
 712
 713 html5CommonAttrs :: CommonAttrs -> Html5 -> Html5
 714 html5CommonAttrs CommonAttrs{id=id_, ..} =
 715         html5AttrClass classes .
 716         maybe Cat.id html5AttrId id_
 717
 718 html5SectionNumber :: PosPath -> Html5
 719 html5SectionNumber = go mempty
 720         where
 721         go :: PosPath -> PosPath -> Html5
 722         go prev next =
 723                 case Seq.viewl next of
 724                  Seq.EmptyL -> pure ()
 725                  a@(_n,rank) Seq.:< as -> do
 726                         H.a ! HA.href ("#"<>attrify (prev Seq.|>a)) $$
 727                                 html5ify $ show rank
 728                         when (not (null as) || null prev) $ do
 729                                 html5ify '.'
 730                                 go (prev Seq.|>a) as
 731
 732 html5SectionRef :: PosPath -> Html5
 733 html5SectionRef as =
 734         H.a ! HA.href ("#"<>attrify as) $$
 735                 html5ify as
 736
 737 -- * 'Attrify'
 738 instance Attrify Anchor where
 739         attrify Anchor{..} = attrify section <> "." <> attrify count
 740 instance Attrify Plain.Plain where
 741         attrify p = attrify t
 742                 where (t,_) = Plain.runPlain p def
 743 instance Attrify PosPath where
 744         attrify = attrify . plainify
 745 instance Attrify DTC.Pos where
 746         attrify = attrify . DTC.posAncestors
 747
 748 attrifyIref :: Words -> H.AttributeValue
 749 attrifyIref term =
 750         "iref" <> "." <> attrify (Anchor.plainifyWords term)
 751 attrifyIrefCount :: Words -> Nat1 -> H.AttributeValue
 752 attrifyIrefCount term count =
 753         "iref"
 754          <> "." <> attrify (Anchor.plainifyWords term)
 755          <> "." <> attrify count
 756
 757 -- * Type 'L10n'
 758 instance Html5ify Plain.L10n where
 759         html5ify = html5ify . plainify
 760 instance Localize ls Plain.Plain Plain.L10n => Localize ls Html5 Plain.L10n where
 761         localize loc a = html5ify (Locale.localize loc a::Plain.Plain)
 762 instance LocalizeIn FR Html5 Plain.L10n where
 763         localizeIn loc = html5ify @Plain.Plain . localizeIn loc
 764 instance LocalizeIn EN Html5 Plain.L10n where
 765         localizeIn loc = html5ify @Plain.Plain . localizeIn loc