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 {-# LANGUAGE ViewPatterns #-}
   9 {-# OPTIONS_GHC -fno-warn-orphans #-}
  10 module Language.DTC.Write.HTML5 where
  11
  12 -- import Control.Monad.Trans.Class (MonadTrans(..))
  13 -- import Data.Functor.Identity (Identity(..))
  14 -- import Data.Sequence (Seq)
  15 -- import Data.Set (Set)
  16 -- import Data.Traversable (Traversable(..))
  17 -- import qualified Data.Sequence as Seq
  18 -- import qualified Data.TreeSeq.Strict as Tree
  19 import Control.Applicative (Applicative(..))
  20 import Control.Category
  21 import Control.Monad
  22 import Data.Bool
  23 import Data.Char (Char)
  24 import Data.Default.Class (Default(..))
  25 import Data.Foldable (Foldable(..), concat)
  26 import Data.Function (($), const, flip, on)
  27 import Data.Functor (Functor(..), (<$>))
  28 import Data.Functor.Compose (Compose(..))
  29 import Data.Int (Int)
  30 import Data.Map.Strict (Map)
  31 import Data.Maybe (Maybe(..), maybe, mapMaybe, fromJust, maybeToList)
  32 import Data.Monoid (Monoid(..))
  33 import Data.Ord (Ord(..))
  34 import Data.Semigroup (Semigroup(..))
  35 import Data.String (String)
  36 import Data.Text (Text)
  37 import Data.TreeSeq.Strict (Tree(..), Trees)
  38 import Data.Tuple (snd)
  39 import System.FilePath (FilePath)
  40 import Text.Blaze ((!))
  41 import Text.Blaze.Html (Html)
  42 import Text.Show (Show(..))
  43 import qualified Control.Monad.Trans.State as S
  44 import qualified Data.Char as Char
  45 import qualified Data.List as List
  46 import qualified Data.Map.Strict as Map
  47 import qualified Data.Sequence as Seq
  48 import qualified Data.Strict.Maybe as Strict
  49 import qualified Data.Text as Text
  50 import qualified Data.Text.Lazy as TL
  51 import qualified Data.TreeMap.Strict as TreeMap
  52 import qualified Data.TreeSeq.Strict as Tree
  53 import qualified Data.TreeSeq.Strict.Zipper as Tree
  54 import qualified Text.Blaze.Html5 as H
  55 import qualified Text.Blaze.Html5.Attributes  as HA
  56 import qualified Text.Blaze.Internal as H
  57
  58 import Text.Blaze.Utils
  59 import Data.Locale hiding (localize, Index)
  60 import qualified Data.Locale as Locale
  61
  62 import Language.DTC.Write.XML ()
  63 import Language.DTC.Write.Plain (Plain, Plainify(..))
  64 import qualified Language.DTC.Write.Plain as Plain
  65 import qualified Language.DTC.Document as DTC
  66 import qualified Language.DTC.Anchor as Anchor
  67
  68 (<&>) :: Functor f => f a -> (a -> b) -> f b
  69 (<&>) = flip (<$>)
  70 infixl 4 <&>
  71
  72 -- * Type 'Html5'
  73 type Html5 = StateMarkup State ()
  74
  75 -- ** Type 'State'
  76 data State
  77  =   State
  78  { state_styles     :: Map FilePath CSS
  79  , state_scripts    :: Map FilePath Script
  80  , state_indexs     :: Map DTC.Pos (DTC.Terms, Anchor.Irefs)
  81  , state_rrefs      :: Anchor.Rrefs
  82  , state_figures    :: Map Text (Map DTC.Pos DTC.Title)
  83  , state_references :: Map DTC.Ident DTC.About
  84  , state_plainify   :: Plain.State
  85  }
  86 instance Default State where
  87         def = State
  88          { state_styles     = mempty
  89          , state_scripts    = mempty
  90          , state_indexs     = mempty
  91          , state_rrefs      = mempty
  92          , state_figures    = mempty
  93          , state_references = mempty
  94          , state_plainify   = def
  95          }
  96 type CSS = Text
  97 type Script = Text
  98
  99 -- ** Type 'Keys'
 100 data Keys
 101  = Keys
 102  { keys_index     :: Map DTC.Pos DTC.Terms
 103  , keys_figure    :: Map Text (Map DTC.Pos DTC.Title)
 104  , keys_reference :: Map DTC.Ident DTC.About
 105  } deriving (Show)
 106
 107 keys :: Trees DTC.BodyKey DTC.BodyValue -> Keys
 108 keys body = foldl' flt (Keys mempty mempty mempty) (Compose body)
 109         where
 110         flt acc = \case
 111          DTC.Index{..} -> acc{keys_index =
 112                 Map.insert pos terms $ keys_index acc}
 113          DTC.Figure{..} -> acc{keys_figure =
 114                 Map.insertWith (<>)
 115                  type_ (Map.singleton pos title) $
 116                 keys_figure acc}
 117          DTC.References{..} -> acc{keys_reference =
 118                 foldr
 119                  (\r -> Map.insert
 120                          (DTC.id    (r::DTC.Reference))
 121                          (DTC.about (r::DTC.Reference)))
 122                  (keys_reference acc)
 123                  refs}
 124          _ -> acc
 125
 126 -- ** Class 'Html5ify'
 127 class Html5ify a where
 128         html5ify :: a -> Html5
 129 instance Html5ify Char where
 130         html5ify = html5ify . H.toMarkup
 131 instance Html5ify Text where
 132         html5ify = html5ify . H.toMarkup
 133 instance Html5ify TL.Text where
 134         html5ify = html5ify . H.toMarkup
 135 instance Html5ify String where
 136         html5ify = html5ify . H.toMarkup
 137 instance Html5ify H.Markup where
 138         html5ify = Compose . return
 139 instance Html5ify DTC.Title where
 140         html5ify (DTC.Title t) = html5ify t
 141 instance Html5ify DTC.Para where
 142         html5ify = mapM_ html5ify
 143 instance Html5ify DTC.Ident where
 144         html5ify (DTC.Ident i) = html5ify i
 145 instance Html5ify Int where
 146         html5ify = html5ify . show
 147 instance Html5ify DTC.Nat where
 148         html5ify (DTC.Nat n) = html5ify n
 149 instance Html5ify DTC.Nat1 where
 150         html5ify (DTC.Nat1 n) = html5ify n
 151
 152 html5Document ::
 153  Localize ls Plain Plain.L10n =>
 154  Locales ls =>
 155  LocaleIn ls -> DTC.Document -> Html
 156 html5Document locale DTC.Document{..} = do
 157         let Keys{..} = keys body
 158         let (body',state_rrefs,state_indexs) =
 159                 let irefs = foldMap Anchor.irefsOfTerms keys_index in
 160                 let (body0, Anchor.State{state_irefs, state_rrefs=rrefs}) =
 161                         Anchor.anchorify body `S.runState`
 162                         Anchor.state{Anchor.state_irefs=irefs} in
 163                 (body0,rrefs,) $
 164                 (<$> keys_index) $ \terms ->
 165                         (terms,) $
 166                         TreeMap.intersection const state_irefs $
 167                         Anchor.irefsOfTerms terms
 168         let state_plainify = def
 169                 { Plain.state_localize = Locale.localize locale }
 170         let (html5Body, State{state_styles,state_scripts}) =
 171                 runStateMarkup def
 172                  { state_indexs
 173                  , state_rrefs
 174                  , state_figures    = keys_figure
 175                  , state_references = keys_reference
 176                  , state_plainify
 177                  } $ html5ify body'
 178
 179         H.docType
 180         H.html ! HA.lang (attrify $ countryCode locale) $ do
 181                 H.head $ do
 182                         H.meta ! HA.httpEquiv "Content-Type"
 183                                ! HA.content "text/html; charset=UTF-8"
 184                         whenSome (DTC.titles $ DTC.about (head :: DTC.Head)) $ \ts ->
 185                                 H.title $
 186                                         H.toMarkup $ Plain.text state_plainify $ List.head ts
 187                         forM_ (DTC.links $ DTC.about (head :: DTC.Head)) $ \DTC.Link{rel, href} ->
 188                                 H.link ! HA.rel (attrify rel)
 189                                        ! HA.href (attrify href)
 190                         H.meta ! HA.name "generator"
 191                                ! HA.content "tct"
 192                         let chapters =
 193                                 (`mapMaybe` toList body) $ \case
 194                                  TreeN k@DTC.Section{} _ -> Just k
 195                                  _ -> Nothing
 196                         forM_ chapters $ \DTC.Section{..} ->
 197                                 H.link ! HA.rel "Chapter"
 198                                        ! HA.title (attrify $ plainify title)
 199                                        ! HA.href ("#"<>attrify pos)
 200                         H.link ! HA.rel "stylesheet"
 201                                ! HA.type_ "text/css"
 202                                ! HA.href "style/dtc-html5.css"
 203                         forM_ state_styles $ \style ->
 204                                 H.style ! HA.type_ "text/css" $
 205                                         H.toMarkup style
 206                         forM_ state_scripts $ \script ->
 207                                 H.script ! HA.type_ "application/javascript" $
 208                                         H.toMarkup script
 209                 H.body
 210                         html5Body
 211
 212 -- * Type 'BodyCursor'
 213 -- | Cursor to navigate within a 'DTC.Body' according to many axis (like in XSLT).
 214 type BodyCursor = Tree.Zipper DTC.BodyKey DTC.BodyValue
 215 instance Html5ify DTC.Body where
 216         html5ify body =
 217                 forM_ (Tree.zippers body) $ \z ->
 218                         forM_ (Tree.axis_repeat Tree.axis_following_sibling_nearest `Tree.runAxis` z) $
 219                                 html5ify
 220
 221 instance Html5ify BodyCursor where
 222         html5ify z =
 223                 case Tree.current z of
 224                  TreeN k _ts -> html5BodyKey z k
 225                  Tree0 v     -> html5BodyValue z v
 226
 227 html5BodyKey :: BodyCursor -> DTC.BodyKey -> Html5
 228 html5BodyKey z = \case
 229          DTC.Section{..} ->
 230                 H.section ! HA.class_ "section"
 231                           ! HA.id (attrify pos) $$ do
 232                         html5CommonAttrs attrs $
 233                                 H.table ! HA.class_ "section-header" $$
 234                                         H.tbody $$
 235                                                 H.tr $$ do
 236                                                         H.td ! HA.class_ "section-number" $$ do
 237                                                                 html5SectionNumber $ DTC.posAncestors pos
 238                                                         H.td ! HA.class_ "section-title" $$ do
 239                                                                 (case List.length $ DTC.posAncestors pos of
 240                                                                  0 -> H.h1
 241                                                                  1 -> H.h2
 242                                                                  2 -> H.h3
 243                                                                  3 -> H.h4
 244                                                                  4 -> H.h5
 245                                                                  5 -> H.h6
 246                                                                  _ -> H.h6) $$
 247                                                                         html5ify title
 248                         forM_ (Tree.axis_child `Tree.runAxis` z) $
 249                                 html5ify
 250 html5BodyValue :: BodyCursor -> DTC.BodyValue -> Html5
 251 html5BodyValue z = \case
 252          DTC.Block b -> html5ify b
 253          DTC.ToC{..} -> do
 254                 H.nav ! HA.class_ "toc"
 255                       ! HA.id (attrify pos) $$ do
 256                         H.span ! HA.class_ "toc-name" $$
 257                                 H.a ! HA.href (attrify pos) $$
 258                                         html5ify Plain.L10n_Table_of_Contents
 259                         H.ul $$
 260                                 forM_ (Tree.axis_following_sibling `Tree.runAxis` z) $
 261                                         html5ifyToC depth
 262          DTC.ToF{..} -> do
 263                 H.nav ! HA.class_ "tof"
 264                       ! HA.id (attrify pos) $$
 265                         H.table ! HA.class_ "tof" $$
 266                                 H.tbody $$
 267                                         html5ifyToF types
 268          DTC.Figure{..} ->
 269                 html5CommonAttrs attrs $
 270                 H.div ! HA.class_ ("figure " <> attrify ("figure-"<>type_))
 271                       ! HA.id (attrify pos) $$ do
 272                         H.table ! HA.class_ "figure-caption" $$
 273                                 H.tbody $$
 274                                         H.tr $$ do
 275                                                 H.td ! HA.class_ "figure-number" $$ do
 276                                                         H.a ! HA.href ("#"<>attrify pos) $$ do
 277                                                                 html5ify type_
 278                                                                 html5ify $ DTC.posAncestors pos
 279                                                         html5ify $ Plain.L10n_Colon
 280                                                 H.td ! HA.class_ "figure-name" $$
 281                                                         html5ify title
 282                         H.div ! HA.class_ "figure-content" $$ do
 283                                 html5ify blocks
 284          DTC.Index{pos} -> do
 285                 (allTerms,refsByTerm) <- liftStateMarkup $ S.gets $ (Map.! pos) . state_indexs
 286                 let chars = Anchor.termsByChar allTerms
 287                 H.div ! HA.class_ "index"
 288                       ! HA.id (attrify pos) $$ do
 289                         H.nav ! HA.class_ "index-nav" $$ do
 290                                 forM_ (Map.keys chars) $ \char ->
 291                                         H.a ! HA.href ("#"<>(attrify pos <> "." <> attrify char)) $$
 292                                                 html5ify char
 293                         H.dl ! HA.class_ "index-chars" $$
 294                                 forM_ (Map.toList chars) $ \(char,terms) -> do
 295                                         H.dt $$
 296                                                 let i = attrify pos <> "." <> attrify char in
 297                                                 H.a ! HA.id i
 298                                                     ! HA.href ("#"<>i) $$
 299                                                         html5ify char
 300                                         H.dd $$
 301                                                 H.dl ! HA.class_ "index-term" $$ do
 302                                                 forM_ terms $ \aliases -> do
 303                                                         H.dt $$
 304                                                                 H.ul ! HA.class_ "index-aliases" $$
 305                                                                         forM_ (List.take 1 aliases) $ \term ->
 306                                                                                 H.li ! HA.id (attrify term) $$
 307                                                                                         html5ify term
 308                                                         H.dd $$
 309                                                                 let anchs =
 310                                                                         List.sortBy (compare `on` DTC.section . snd) $
 311                                                                         (`foldMap` aliases) $ \words ->
 312                                                                                 fromJust $ do
 313                                                                                         path <- Anchor.pathFromWords words
 314                                                                                         Strict.maybe Nothing (Just . ((words,) <$>) . List.reverse) $
 315                                                                                                 TreeMap.lookup path refsByTerm in
 316                                                                 html5CommasDot $
 317                                                                 (<$> anchs) $ \(term,DTC.Anchor{..}) ->
 318                                                                         H.a ! HA.class_ "index-iref"
 319                                                                             ! HA.href ("#"<>attrify (term,count)) $$
 320                                                                                 html5ify $ DTC.posAncestors section
 321          DTC.References{..} ->
 322                 html5CommonAttrs attrs $
 323                 H.div ! HA.class_ "references"
 324                       ! HA.id (attrify pos) $$ do
 325                         H.table $$
 326                                 forM_ refs html5ify
 327
 328 instance Html5ify DTC.Words where
 329         html5ify = html5ify . Anchor.plainifyWords
 330
 331 cleanPara :: DTC.Para -> DTC.Para
 332 cleanPara p =
 333         p >>= (`Tree.bindTrees` \case
 334          TreeN DTC.Iref{} ls -> ls
 335          TreeN DTC.Note{} _  -> mempty
 336          h -> pure h)
 337
 338 html5ifyToC :: Maybe DTC.Nat -> BodyCursor -> Html5
 339 html5ifyToC depth z =
 340         case Tree.current z of
 341          TreeN DTC.Section{..} _ts -> do
 342                 H.li $$ do
 343                         H.table ! HA.class_ "toc-entry" $$
 344                                 H.tbody $$
 345                                         H.tr $$ do
 346                                                 H.td ! HA.class_ "section-number" $$
 347                                                         html5SectionRef $ DTC.posAncestors pos
 348                                                 H.td ! HA.class_ "section-title" $$
 349                                                         html5ify $ cleanPara $ DTC.unTitle title
 350                         when (maybe True (> DTC.Nat 1) depth && not (null sections)) $
 351                                 H.ul $$
 352                                         forM_ sections $
 353                                                 html5ifyToC (depth >>= DTC.predNat)
 354          _ -> pure ()
 355         where
 356         sections =
 357                 (`Tree.runAxis` z) $
 358                 Tree.axis_child
 359                 `Tree.axis_filter_current` \case
 360                  TreeN DTC.Section{} _ -> True
 361                  _ -> False
 362
 363 html5ifyToF :: [Text] -> Html5
 364 html5ifyToF types = do
 365         figsByType <- liftStateMarkup $ S.gets state_figures
 366         let figs =
 367                 Map.foldMapWithKey (\ty -> ((ty,) <$>)) $
 368                 if null types
 369                 then figsByType
 370                 else
 371                         Map.intersection figsByType $
 372                         Map.fromList [(ty,()) | ty <- types]
 373         forM_ (Map.toList figs) $ \(pos, (type_, title)) ->
 374                 H.tr $$ do
 375                         H.td ! HA.class_ "figure-number" $$
 376                                 H.a ! HA.href ("#"<>attrify pos) $$ do
 377                                         html5ify type_
 378                                         html5ify $ DTC.posAncestors pos
 379                         H.td ! HA.class_ "figure-name" $$
 380                                 html5ify $ cleanPara $ DTC.unTitle title
 381
 382 instance Html5ify [DTC.Block] where
 383         html5ify = mapM_ html5ify
 384 instance Html5ify DTC.Block where
 385         html5ify = \case
 386          DTC.Para{..} ->
 387                 html5CommonAttrs attrs $
 388                 H.p ! HA.class_ "para"
 389                     ! HA.id (attrify pos) $$ do
 390                         html5ify para
 391          DTC.OL{..} ->
 392                 html5CommonAttrs attrs $
 393                 H.ol ! HA.class_ "ol"
 394                      ! HA.id (attrify pos) $$ do
 395                         forM_ items $ \item ->
 396                                 H.li $$ html5ify item
 397          DTC.UL{..} ->
 398                 html5CommonAttrs attrs $
 399                 H.ul ! HA.class_ "ul"
 400                      ! HA.id (attrify pos) $$ do
 401                         forM_ items $ \item ->
 402                                 H.li $$ html5ify item
 403          DTC.Comment t ->
 404                 html5ify $ H.Comment (H.Text t) ()
 405 instance Html5ify DTC.Lines where
 406         html5ify = \case
 407          Tree0 v ->
 408                 case v of
 409                  DTC.BR      -> html5ify H.br
 410                  DTC.Plain t -> html5ify t
 411          TreeN k ls ->
 412                 case k of
 413                  DTC.B    -> H.strong $$ html5ify ls
 414                  DTC.Code -> H.code   $$ html5ify ls
 415                  DTC.Del  -> H.del    $$ html5ify ls
 416                  DTC.I    -> do
 417                         i <- liftStateMarkup $ do
 418                                 i <- S.gets $ Plain.state_italic . state_plainify
 419                                 S.modify $ \s ->
 420                                         s{state_plainify=
 421                                                 (state_plainify s){Plain.state_italic=
 422                                                         not i}}
 423                                 return i
 424                         H.em ! HA.class_ (if i then "even" else "odd") $$
 425                                 html5ify ls
 426                         liftStateMarkup $
 427                                 S.modify $ \s ->
 428                                         s{state_plainify=
 429                                                 (state_plainify s){Plain.state_italic=i}}
 430                  DTC.Sub  -> H.sub    $$ html5ify ls
 431                  DTC.Sup  -> H.sup    $$ html5ify ls
 432                  DTC.SC   -> H.span ! HA.class_ "smallcaps" $$ html5ify ls
 433                  DTC.U    -> H.span ! HA.class_ "underline" $$ html5ify ls
 434                  DTC.Note -> ""
 435                  DTC.Q -> do
 436                         d <- liftStateMarkup $ do
 437                                 d <- S.gets $ Plain.state_quote . state_plainify
 438                                 S.modify $ \s -> s{state_plainify=
 439                                         (state_plainify s){Plain.state_quote=
 440                                                 DTC.succNat d}}
 441                                 return d
 442                         H.span ! HA.class_ "q" $$ do
 443                                 html5ify $ Plain.L10n_QuoteOpen d
 444                                 html5ify $ TreeN DTC.I ls
 445                                 html5ify $ Plain.L10n_QuoteClose d
 446                         liftStateMarkup $
 447                                 S.modify $ \s ->
 448                                         s{state_plainify=
 449                                                 (state_plainify s){Plain.state_quote = d}}
 450                  DTC.Eref{..} ->
 451                         H.a ! HA.class_ "eref"
 452                             ! HA.href (attrify href) $$
 453                                 if null ls
 454                                 then html5ify $ DTC.unURL href
 455                                 else html5ify ls
 456                  DTC.Iref{..} ->
 457                         case anchor of
 458                          Nothing -> html5ify ls
 459                          Just DTC.Anchor{..} ->
 460                                 H.span ! HA.class_ "iref"
 461                                        ! HA.id (attrify (term,count)) $$
 462                                         html5ify ls
 463                  DTC.Ref{..} ->
 464                         H.a ! HA.class_ "ref"
 465                             ! HA.href ("#"<>attrify to) $$
 466                         if null ls
 467                         then html5ify to
 468                         else html5ify ls
 469                  DTC.Rref{..} -> do
 470                         refs <- liftStateMarkup $ S.gets state_references
 471                         case Map.lookup to refs of
 472                          Nothing -> do
 473                                 "["::Html5
 474                                 H.span ! HA.class_ "rref-broken" $$
 475                                         html5ify to
 476                                 "]"
 477                          Just DTC.About{..} -> do
 478                                 when (not $ null ls) $
 479                                         forM_ (List.take 1 titles) $ \(DTC.Title title) -> do
 480                                                 html5ify $ TreeN DTC.Q $
 481                                                         case url of
 482                                                          Nothing -> title
 483                                                          Just u -> pure $ TreeN (DTC.Eref u) title
 484                                                 " "::Html5
 485                                 "["::Html5
 486                                 H.a ! HA.class_ "rref"
 487                                     ! HA.href ("#rref."<>attrify to)
 488                                     ! HA.id ("rref."<>attrify to<>maybe "" (\DTC.Anchor{..} -> "."<>attrify count) anchor) $$
 489                                         html5ify to
 490                                 "]"
 491 instance Html5ify DTC.URL where
 492         html5ify (DTC.URL url) =
 493                 H.a ! HA.class_ "eref"
 494                     ! HA.href (attrify url) $$
 495                         html5ify url
 496
 497 instance Attrify DTC.Words where
 498         attrify term =
 499                 "iref" <> "." <> attrify (Anchor.plainifyWords term)
 500 instance Attrify (DTC.Words,DTC.Nat1) where
 501         attrify (term,count) =
 502                 "iref"
 503                  <> "." <> attrify (Anchor.plainifyWords term)
 504                  <> "." <> attrify count
 505 instance Html5ify DTC.Date where
 506         html5ify = html5ify . Plain.L10n_Date
 507 instance Html5ify DTC.About where
 508         html5ify DTC.About{..} =
 509                 html5CommasDot $ concat $
 510                  [ html5Titles titles
 511                  , html5Entity <$> authors
 512                  , html5ify    <$> maybeToList date
 513                  , html5Entity <$> maybeToList editor
 514                  , html5Serie  <$> series
 515                  ]
 516                 where
 517                 html5Titles :: [DTC.Title] -> [Html5]
 518                 html5Titles ts | null ts = []
 519                 html5Titles ts = [html5Title $ fold $ List.intersperse t $ toList ts]
 520                         where t = DTC.Title $ Seq.singleton $ Tree0 $ DTC.Plain " — "
 521                 html5Title (DTC.Title title) =
 522                         html5ify $ TreeN DTC.Q $
 523                                 case url of
 524                                  Nothing -> title
 525                                  Just u -> pure $ TreeN (DTC.Eref u) title
 526                 html5SerieHref href DTC.Serie{..} = do
 527                         sp <- liftStateMarkup $ S.gets state_plainify
 528                         html5ify $
 529                                 TreeN DTC.Eref{href} $
 530                                 Seq.fromList
 531                                  [ Tree0 $ DTC.Plain $ name
 532                                  , Tree0 $ DTC.Plain $ TL.toStrict $ Plain.text sp Plain.L10n_Colon
 533                                  , Tree0 $ DTC.Plain key
 534                                  ]
 535                 html5Serie s@DTC.Serie{name="RFC", key} | Text.all Char.isDigit key =
 536                         html5SerieHref (DTC.URL $ "https://tools.ietf.org/html/rfc"<>key) s
 537                 html5Serie s@DTC.Serie{name="DOI", key} =
 538                         html5SerieHref (DTC.URL $ "https://dx.doi.org/"<>key) s
 539                 html5Serie DTC.Serie{..} = do
 540                         html5ify name
 541                         html5ify Plain.L10n_Colon
 542                         html5ify key
 543                 html5Entity DTC.Entity{url=mu, ..} = do
 544                         html5ify @DTC.Lines $
 545                                 case () of
 546                                  _ | not (Text.null email) ->
 547                                         TreeN (DTC.Eref $ DTC.URL $ "mailto:"<>email) $
 548                                                 pure $ Tree0 $ DTC.Plain name
 549                                  _ | Just u <- mu  ->
 550                                         TreeN (DTC.Eref u) $
 551                                                 pure $ Tree0 $ DTC.Plain name
 552                                  _ -> Tree0 $ DTC.Plain name
 553                         forM_ org $ \o -> do
 554                                 " ("::Html5
 555                                 html5Entity o
 556                                 ")"::Html5
 557 instance Html5ify DTC.Reference where
 558         html5ify DTC.Reference{id=id_, ..} =
 559                 H.tr $$ do
 560                         H.td ! HA.class_ "reference-key" $$
 561                                 html5ify @DTC.Lines $ TreeN DTC.Rref{anchor=Nothing, to=id_} Seq.empty
 562                         H.td ! HA.class_ "reference-content" $$ do
 563                                 html5ify about
 564                                 rrefs <- liftStateMarkup $ S.gets state_rrefs
 565                                 case Map.lookup id_ rrefs of
 566                                  Nothing -> pure ()
 567                                  Just anchs ->
 568                                         H.span ! HA.class_ "reference-rrefs" $$
 569                                                 html5CommasDot $
 570                                                 (<$> List.reverse anchs) $ \DTC.Anchor{..} ->
 571                                                         H.a ! HA.class_ "reference-rref"
 572                                                             ! HA.href ("#rref."<>attrify id_<>"."<>attrify count) $$
 573                                                                 html5ify $ DTC.posAncestors section
 574
 575 html5CommasDot :: [Html5] -> Html5
 576 html5CommasDot [] = pure ()
 577 html5CommasDot hs = do
 578         sequence_ $ List.intersperse ", " hs
 579         "."
 580
 581 html5CommonAttrs :: DTC.CommonAttrs -> Html5 -> Html5
 582 html5CommonAttrs DTC.CommonAttrs{id=id_, ..} =
 583         Compose . (addClass . addId <$>) . getCompose
 584         where
 585         addClass =
 586                 case classes of
 587                  [] -> id
 588                  _  -> H.AddCustomAttribute "class" (H.Text $ Text.unwords classes)
 589         addId = maybe id (\(DTC.Ident i) ->
 590                 H.AddCustomAttribute "id" (H.Text i)) id_
 591
 592 html5SectionNumber :: DTC.PosPath -> Html5
 593 html5SectionNumber = go mempty
 594         where
 595         go :: DTC.PosPath -> DTC.PosPath -> Html5
 596         go prev next =
 597                 case Seq.viewl next of
 598                  Seq.EmptyL -> pure ()
 599                  a@(_n,rank) Seq.:< as -> do
 600                         H.a ! HA.href ("#"<>attrify (prev Seq.|>a)) $$
 601                                 html5ify $ show rank
 602                         when (not (null as) || null prev) $ do
 603                                 html5ify '.'
 604                                 go (prev Seq.|>a) as
 605
 606 html5SectionRef :: DTC.PosPath -> Html5
 607 html5SectionRef as =
 608         H.a ! HA.href ("#"<>attrify as) $$
 609                 html5ify as
 610
 611 instance Html5ify DTC.PosPath where
 612         html5ify ancs =
 613                 case toList ancs of
 614                  [(_n,c)] -> do
 615                         html5ify $ show c
 616                         html5ify '.'
 617                  as ->
 618                         html5ify $
 619                                 Text.intercalate "." $
 620                                 Text.pack . show . snd <$> as
 621 instance Html5ify Plain where
 622         html5ify p = do
 623                 sp <- liftStateMarkup $ S.gets state_plainify
 624                 let (t,sp') = Plain.runPlain p sp
 625                 html5ify t
 626                 liftStateMarkup $ S.modify $ \s -> s{state_plainify=sp'}
 627 instance Attrify Plain where
 628         attrify p =
 629                 let (t,_) = Plain.runPlain p def in
 630                 attrify t
 631
 632 instance Attrify DTC.PosPath where
 633         attrify = attrify . plainify
 634 instance Attrify DTC.Pos where
 635         attrify = attrify . DTC.posAncestors
 636
 637 -- * Type 'L10n'
 638 instance Html5ify Plain.L10n where
 639         html5ify = html5ify . plainify
 640 instance Localize ls Plain Plain.L10n => Localize ls Html5 Plain.L10n where
 641         localize loc a = html5ify (Locale.localize loc a::Plain)
 642 instance LocalizeIn FR Html5 Plain.L10n where
 643         localizeIn loc = html5ify @Plain . localizeIn loc
 644 instance LocalizeIn EN Html5 Plain.L10n where
 645         localizeIn loc = html5ify @Plain . localizeIn loc