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