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 ls Plain.Plain Plain.L10n =>
  61  Locales ls =>
  62  LocaleIn ls -> 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 -> H.ol $$ do
 464                 forM_ items $ \item ->
 465                         H.li $$ html5ify item
 466          ParaUL items -> H.ul $$ do
 467                 forM_ items $ \item ->
 468                         H.li $$ html5ify item
 469 instance Html5ify [Para] where
 470         html5ify = mapM_ html5ify
 471
 472 instance Html5ify Plain where
 473         html5ify ps =
 474                 case Seq.viewl ps of
 475                  Seq.EmptyL -> mempty
 476                  curr Seq.:< next ->
 477                         case curr of
 478                         -- NOTE: gather adjacent PlainNotes
 479                          Tree PlainNote{} _
 480                           | (notes, rest) <- Seq.spanl (\case {Tree PlainNote{} _ -> True; _ -> False}) next -> do
 481                                 H.sup ! HA.class_ "note-numbers" $$ do
 482                                         html5ify curr
 483                                         forM_ notes $ \note -> do
 484                                                 ", "::Html5
 485                                                 html5ify note
 486                                 " "::Html5
 487                                 html5ify rest
 488                         --
 489                          _ -> do
 490                                 html5ify curr
 491                                 html5ify next
 492 instance Html5ify (Tree PlainNode)
 493  where html5ify (Tree n ls) =
 494         case n of
 495          PlainBR     -> html5ify H.br
 496          PlainText t -> html5ify t
 497          PlainGroup  -> html5ify ls
 498          PlainB      -> H.strong $$ html5ify ls
 499          PlainCode   -> H.code   $$ html5ify ls
 500          PlainDel    -> H.del    $$ html5ify ls
 501          PlainI -> do
 502                 i <- liftStateMarkup $ do
 503                         i <- S.gets $ Plain.state_italic . state_plainify
 504                         S.modify $ \s ->
 505                                 s{state_plainify=
 506                                         (state_plainify s){Plain.state_italic=
 507                                                 not i}}
 508                         return i
 509                 H.em ! HA.class_ (if i then "even" else "odd") $$
 510                         html5ify ls
 511                 liftStateMarkup $
 512                         S.modify $ \s ->
 513                                 s{state_plainify=
 514                                         (state_plainify s){Plain.state_italic=i}}
 515          PlainSub  -> H.sub    $$ html5ify ls
 516          PlainSup  -> H.sup    $$ html5ify ls
 517          PlainSC   -> H.span ! HA.class_ "smallcaps" $$ html5ify ls
 518          PlainU    -> H.span ! HA.class_ "underline" $$ html5ify ls
 519          PlainNote{..} ->
 520                 case number of
 521                  Nothing -> mempty
 522                  Just num ->
 523                         H.a ! HA.class_ "note-ref"
 524                             ! HA.id ("note-ref."<>attrify num)
 525                             ! HA.href ("#note."<>attrify num) $$
 526                                 html5ify num
 527          PlainQ -> do
 528                 depth <- liftStateMarkup $ do
 529                         depth <- S.gets $ Plain.state_quote . state_plainify
 530                         S.modify $ \s -> s{state_plainify=
 531                                 (state_plainify s){Plain.state_quote=
 532                                         succNat depth}}
 533                         return depth
 534                 H.span ! HA.class_ "q" $$ do
 535                         html5ify $ Plain.L10n_QuoteOpen depth
 536                         html5ify $ Tree PlainI ls
 537                         html5ify $ Plain.L10n_QuoteClose depth
 538                 liftStateMarkup $
 539                         S.modify $ \s ->
 540                                 s{state_plainify=
 541                                         (state_plainify s){Plain.state_quote = depth}}
 542          PlainEref{..} ->
 543                 H.a ! HA.class_ "eref"
 544                     ! HA.href (attrify href) $$
 545                         if null ls
 546                         then html5ify $ unURL href
 547                         else html5ify ls
 548          PlainIref{..} ->
 549                 case anchor of
 550                  Nothing -> html5ify ls
 551                  Just Anchor{..} ->
 552                         H.span ! HA.class_ "iref"
 553                                ! HA.id (attrifyIrefCount term count) $$
 554                                 html5ify ls
 555          PlainRef{..} ->
 556                 H.a ! HA.class_ "ref"
 557                     ! HA.href ("#"<>attrify to) $$
 558                 if null ls
 559                 then html5ify to
 560                 else html5ify ls
 561          PlainRref{..} -> do
 562                 refs <- liftStateMarkup $ S.gets state_references
 563                 case Map.lookup to refs of
 564                  Nothing -> do
 565                         "["::Html5
 566                         H.span ! HA.class_ "rref-broken" $$
 567                                 html5ify to
 568                         "]"
 569                  Just About{..} -> do
 570                         unless (null ls) $
 571                                 forM_ (List.take 1 titles) $ \(Title title) -> do
 572                                         html5ify $ Tree PlainQ $
 573                                                 case url of
 574                                                  Nothing -> title
 575                                                  Just u -> pure $ Tree (PlainEref u) title
 576                                         " "::Html5
 577                         "["::Html5
 578                         H.a ! HA.class_ "rref"
 579                             ! HA.href ("#rref."<>attrify to)
 580                             ! HA.id ("rref."<>attrify to<>maybe "" (\Anchor{..} -> "."<>attrify count) anchor) $$
 581                                 html5ify to
 582                         "]"
 583
 584 instance Html5ify About where
 585         html5ify About{..} =
 586                 html5CommasDot $ concat $
 587                  [ html5Titles titles
 588                  , html5Entity <$> authors
 589                  , html5ify    <$> maybeToList date
 590                  , html5Entity <$> maybeToList editor
 591                  , html5Serie  <$> series
 592                  ]
 593                 where
 594                 html5Titles :: [Title] -> [Html5]
 595                 html5Titles ts | null ts = []
 596                 html5Titles ts = [html5Title $ fold $ List.intersperse t $ toList ts]
 597                         where t = Title $ Seq.singleton $ tree0 $ PlainText " — "
 598                 html5Title (Title title) =
 599                         html5ify $ Tree PlainQ $
 600                                 case url of
 601                                  Nothing -> title
 602                                  Just u -> pure $ Tree (PlainEref u) title
 603                 html5SerieHref href Serie{..} = do
 604                         sp <- liftStateMarkup $ S.gets state_plainify
 605                         html5ify $
 606                                 Tree PlainEref{href} $
 607                                 Seq.fromList
 608                                  [ tree0 $ PlainText $ name
 609                                  , tree0 $ PlainText $ Plain.text sp Plain.L10n_Colon
 610                                  , tree0 $ PlainText key
 611                                  ]
 612                 html5Serie s@Serie{name="RFC", key} | TL.all Char.isDigit key =
 613                         html5SerieHref (URL $ "https://tools.ietf.org/html/rfc"<>key) s
 614                 html5Serie s@Serie{name="DOI", key} =
 615                         html5SerieHref (URL $ "https://dx.doi.org/"<>key) s
 616                 html5Serie Serie{..} = do
 617                         html5ify name
 618                         html5ify Plain.L10n_Colon
 619                         html5ify key
 620                 html5Entity Entity{url=mu, ..} = do
 621                         html5ify $
 622                                 case () of
 623                                  _ | not (TL.null email) ->
 624                                         Tree (PlainEref $ URL $ "mailto:"<>email) $
 625                                                 pure $ tree0 $ PlainText name
 626                                  _ | Just u <- mu ->
 627                                         Tree (PlainEref u) $
 628                                                 pure $ tree0 $ PlainText name
 629                                  _ -> tree0 $ PlainText name
 630                         forM_ org $ \o -> do
 631                                 " ("::Html5
 632                                 html5Entity o
 633                                 ")"::Html5
 634 instance Html5ify Words where
 635         html5ify = html5ify . Anchor.plainifyWords
 636 instance Html5ify Alias where
 637         html5ify Alias{id=id_, ..} = do
 638                 H.a ! HA.class_ "alias"
 639                     ! HA.id (attrify id_) $$
 640                         mempty
 641 instance Html5ify URL where
 642         html5ify (URL url) =
 643                 H.a ! HA.class_ "eref"
 644                     ! HA.href (attrify url) $$
 645                         html5ify url
 646 instance Html5ify Date where
 647         html5ify = html5ify . Plain.L10n_Date
 648 instance Html5ify Reference where
 649         html5ify Reference{id=id_, ..} =
 650                 H.tr $$ do
 651                         H.td ! HA.class_ "reference-key" $$
 652                                 html5ify $ Tree PlainRref{anchor=Nothing, to=id_} Seq.empty
 653                         H.td ! HA.class_ "reference-content" $$ do
 654                                 html5ify about
 655                                 rrefs <- liftStateMarkup $ S.gets state_rrefs
 656                                 case Map.lookup id_ rrefs of
 657                                  Nothing -> pure ()
 658                                  Just anchs ->
 659                                         H.span ! HA.class_ "reference-rrefs" $$
 660                                                 html5CommasDot $
 661                                                 (<$> List.reverse anchs) $ \Anchor{..} ->
 662                                                         H.a ! HA.class_ "reference-rref"
 663                                                             ! HA.href ("#rref."<>attrify id_<>"."<>attrify count) $$
 664                                                                 html5ify $ DTC.posAncestors section
 665 instance Html5ify PosPath where
 666         html5ify ancs =
 667                 case toList ancs of
 668                  [(_n,c)] -> do
 669                         html5ify $ show c
 670                         html5ify '.'
 671                  as ->
 672                         html5ify $
 673                                 Text.intercalate "." $
 674                                 Text.pack . show . snd <$> as
 675 instance Html5ify Plain.Plain where
 676         html5ify p = do
 677                 sp <- liftStateMarkup $ S.gets state_plainify
 678                 let (t,sp') = Plain.runPlain p sp
 679                 html5ify t
 680                 liftStateMarkup $ S.modify $ \s -> s{state_plainify=sp'}
 681
 682 html5CommasDot :: [Html5] -> Html5
 683 html5CommasDot [] = pure ()
 684 html5CommasDot hs = do
 685         sequence_ $ List.intersperse ", " hs
 686         "."
 687
 688 html5AttrClass :: [TL.Text] -> Html5 -> Html5
 689 html5AttrClass = \case
 690  [] -> Cat.id
 691  cls  ->
 692         Compose .
 693         (H.AddCustomAttribute "class"
 694          (H.String $ TL.unpack $ TL.unwords cls) <$>) .
 695         getCompose
 696
 697 html5AttrId :: Ident -> Html5 -> Html5
 698 html5AttrId (Ident id_) =
 699         Compose .
 700         (H.AddCustomAttribute "id"
 701          (H.String $ TL.unpack id_) <$>) .
 702         getCompose
 703
 704 html5CommonAttrs :: CommonAttrs -> Html5 -> Html5
 705 html5CommonAttrs CommonAttrs{id=id_, ..} =
 706         html5AttrClass classes .
 707         maybe Cat.id html5AttrId id_
 708
 709 html5SectionNumber :: PosPath -> Html5
 710 html5SectionNumber = go mempty
 711         where
 712         go :: PosPath -> PosPath -> Html5
 713         go prev next =
 714                 case Seq.viewl next of
 715                  Seq.EmptyL -> pure ()
 716                  a@(_n,rank) Seq.:< as -> do
 717                         H.a ! HA.href ("#"<>attrify (prev Seq.|>a)) $$
 718                                 html5ify $ show rank
 719                         when (not (null as) || null prev) $ do
 720                                 html5ify '.'
 721                                 go (prev Seq.|>a) as
 722
 723 html5SectionRef :: PosPath -> Html5
 724 html5SectionRef as =
 725         H.a ! HA.href ("#"<>attrify as) $$
 726                 html5ify as
 727
 728 -- * 'Attrify'
 729 instance Attrify Anchor where
 730         attrify Anchor{..} = attrify section <> "." <> attrify count
 731 instance Attrify Plain.Plain where
 732         attrify p = attrify t
 733                 where (t,_) = Plain.runPlain p def
 734 instance Attrify PosPath where
 735         attrify = attrify . plainify
 736 instance Attrify DTC.Pos where
 737         attrify = attrify . DTC.posAncestors
 738
 739 attrifyIref :: Words -> H.AttributeValue
 740 attrifyIref term =
 741         "iref" <> "." <> attrify (Anchor.plainifyWords term)
 742 attrifyIrefCount :: Words -> Nat1 -> H.AttributeValue
 743 attrifyIrefCount term count =
 744         "iref"
 745          <> "." <> attrify (Anchor.plainifyWords term)
 746          <> "." <> attrify count
 747
 748 -- * Type 'L10n'
 749 instance Html5ify Plain.L10n where
 750         html5ify = html5ify . plainify
 751 instance Localize ls Plain.Plain Plain.L10n => Localize ls Html5 Plain.L10n where
 752         localize loc a = html5ify (Locale.localize loc a::Plain.Plain)
 753 instance LocalizeIn FR Html5 Plain.L10n where
 754         localizeIn loc = html5ify @Plain.Plain . localizeIn loc
 755 instance LocalizeIn EN Html5 Plain.L10n where
 756         localizeIn loc = html5ify @Plain.Plain . localizeIn loc