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