1 {-# LANGUAGE DataKinds #-}
2 {-# LANGUAGE DuplicateRecordFields #-}
3 {-# LANGUAGE ExistentialQuantification #-}
4 {-# LANGUAGE FlexibleInstances #-}
5 {-# LANGUAGE FlexibleContexts #-}
6 {-# LANGUAGE MultiParamTypeClasses #-}
7 {-# LANGUAGE OverloadedStrings #-}
8 {-# LANGUAGE ScopedTypeVariables #-}
9 {-# LANGUAGE TypeApplications #-}
10 {-# OPTIONS_GHC -fno-warn-orphans #-}
11 module Language.DTC.Write.HTML5 where
13 import Control.Applicative (Applicative(..))
14 import Control.Category as Cat
17 import Data.Char (Char)
18 import Data.Default.Class (Default(..))
19 import Data.Either (Either(..))
20 import Data.Eq (Eq(..))
21 import Data.Foldable (Foldable(..), concat, any)
22 import Data.Function (($), const, on)
23 import Data.Functor ((<$>))
24 import Data.Functor.Compose (Compose(..))
26 import Data.Map.Strict (Map)
27 import Data.Maybe (Maybe(..), maybe, mapMaybe, fromJust, maybeToList)
28 import Data.Monoid (Monoid(..))
29 import Data.Ord (Ord(..))
30 import Data.Semigroup (Semigroup(..))
31 import Data.String (String, IsString(..))
32 import Data.Text (Text)
33 import Data.TreeSeq.Strict (Tree(..), tree0)
34 import Data.Tuple (snd)
36 import System.FilePath (FilePath)
37 import Text.Blaze ((!))
38 import Text.Blaze.Html (Html)
39 import Text.Show (Show(..))
40 import qualified Control.Monad.Trans.State as S
41 import qualified Data.List as List
42 import qualified Data.Map.Strict as Map
43 import qualified Data.Sequence as Seq
44 import qualified Data.Strict.Maybe as Strict
45 import qualified Data.Text as Text
46 import qualified Data.Text.Lazy as TL
47 import qualified Data.TreeMap.Strict as TreeMap
48 import qualified Data.TreeSeq.Strict.Zipper as Tree
49 import qualified Text.Blaze.Html5 as H
50 import qualified Text.Blaze.Html5.Attributes as HA
51 import qualified Text.Blaze.Internal as H
53 import Text.Blaze.Utils
54 import Data.Locale hiding (Index)
56 import Language.DTC.Document as DTC
57 import Language.DTC.Write.Plain (Plainify(..))
58 import Language.DTC.Write.XML ()
59 import qualified Language.DTC.Anchor as Anchor
60 import qualified Language.DTC.Write.Plain as Plain
62 writeHTML5 :: Config -> DTC.Document -> Html
63 writeHTML5 conf@Config{..} DTC.Document{..} = do
64 let Keys{..} = keys body `S.execState` def
65 let (body',state_rrefs,state_notes,state_indexs) =
66 let irefs = foldMap Anchor.irefsOfTerms keys_index in
67 let (body0, Anchor.State{state_irefs, state_rrefs=rrefs, state_notes=notes}) =
68 Anchor.anchorify body `S.runState`
69 def{Anchor.state_irefs=irefs} in
70 (body0,rrefs,notes,) $
71 (<$> keys_index) $ \terms ->
73 TreeMap.intersection const state_irefs $
74 Anchor.irefsOfTerms terms
75 let state_plainify = def{ Plain.state_l10n = loqualize config_locale}
76 let (html5Body, endState) =
81 , state_figures = keys_figure
82 , state_references = keys_reference
84 , state_l10n = loqualize config_locale
86 html5DocumentHead head
89 H.html ! HA.lang (attrify $ countryCode config_locale) $ do
90 html5Head conf endState head body
93 html5Head :: Config -> State -> Head -> Body -> Html
94 html5Head Config{..} State{..} Head{DTC.about=About{..}} body = do
96 H.meta ! HA.httpEquiv "Content-Type"
97 ! HA.content "text/html; charset=UTF-8"
98 unless (null titles) $ do
100 H.toMarkup $ Plain.text state_plainify $ List.head titles
101 forM_ links $ \Link{rel, href} ->
102 H.link ! HA.rel (attrify rel)
103 ! HA.href (attrify href)
105 H.link ! HA.rel "self"
106 ! HA.href (attrify href)
107 unless (TL.null config_generator) $ do
108 H.meta ! HA.name "generator"
109 ! HA.content (attrify config_generator)
111 H.meta ! HA.name "keywords"
112 ! HA.content (attrify $ TL.intercalate ", " tags)
114 (`mapMaybe` toList body) $ \case
115 Tree k@BodySection{} _ -> Just k
117 forM_ chapters $ \case
119 H.link ! HA.rel "Chapter"
120 ! HA.title (attrify $ plainify title)
121 ! HA.href ("#"<>attrify pos)
123 unless (any (\DTC.Link{rel} -> rel == "stylesheet") links) $ do
127 H.link ! HA.rel "stylesheet"
128 ! HA.type_ "text/css"
129 ! HA.href (attrify css)
131 H.style ! HA.type_ "text/css" $
132 -- NOTE: as a special case, H.style wraps its content into an External,
133 -- so it does not HTML-escape its content.
135 forM_ state_styles $ \style ->
136 H.style ! HA.type_ "text/css" $
138 unless (any (\DTC.Link{rel} -> rel == "script") links) $ do
139 forM_ state_scripts $ \script ->
140 H.script ! HA.type_ "application/javascript" $
143 html5DocumentHead :: Head -> Html5
144 html5DocumentHead Head{DTC.about=About{..}} = do
145 H.div ! HA.class_ "document-head" $$
149 H.td ! HA.class_ "left" $$ docHeaders
150 H.td ! HA.class_ "right" $$ docAuthors
151 unless (null titles) $
152 H.div ! HA.class_ "title" $$ do
153 forM_ titles $ \title ->
154 H.h1 $$ html5ify title
157 H.table ! HA.class_ "document-headers" $$
159 Loqualization loc <- liftStateMarkup $ S.gets state_l10n
160 forM_ series $ \s@Serie{id=id_, name} ->
164 headerName $ html5ify name
165 headerValue $ html5ify id_
167 headerName $ html5ify name
169 H.a ! HA.href (attrify href) $$
173 headerName $ l10n_Header_Date loc
174 headerValue $ html5ify d
177 headerName $ l10n_Header_Address loc
178 headerValue $ html5ify $ tree0 $ PlainEref{href}
179 forM_ links $ \Link{..} ->
180 unless (TL.null name) $
182 headerName $ html5ify name
183 headerValue $ html5ify $ Tree PlainEref{href} plain
184 forM_ headers $ \Header{..} ->
186 headerName $ html5ify name
187 headerValue $ html5ify value
189 H.table ! HA.class_ "document-authors" $$
191 forM_ authors $ \a ->
193 H.td ! HA.class_ "author" $$
195 header :: Html5 -> Html5
196 header h = H.tr ! HA.class_ "header" $$ h
197 headerName :: Html5 -> Html5
199 H.td ! HA.class_ "header-name" $$ do
201 Loqualization loc <- liftStateMarkup $ S.gets state_l10n
203 headerValue :: Html5 -> Html5
205 H.td ! HA.class_ "header-value" $$ do
212 , Loqualize locales (L10n Html5)
213 , Loqualize locales (Plain.L10n Plain.Plain)
216 { config_css :: Either FilePath TL.Text
217 , config_locale :: LocaleIn locales
218 , config_generator :: TL.Text
220 instance Default Config where
222 { config_css = Right "style/dtc-html5.css"
223 , config_locale = LocaleIn @'[EN] en_US
224 , config_generator = "https://hackage.haskell.org/package/hdoc"
228 type Html5 = StateMarkup State ()
229 instance IsString Html5 where
230 fromString = html5ify
235 { state_styles :: Map FilePath TL.Text
236 , state_scripts :: Map FilePath TL.Text
237 , state_indexs :: Map DTC.Pos (Terms, Anchor.Irefs)
238 , state_rrefs :: Anchor.Rrefs
239 , state_figures :: Map TL.Text (Map DTC.Pos (Maybe Title))
240 , state_references :: Map Ident About
241 , state_notes :: Anchor.Notes
242 , state_plainify :: Plain.State
243 , state_l10n :: Loqualization (L10n Html5)
245 instance Default State where
248 , state_scripts = def
251 , state_figures = def
252 , state_references = def
254 , state_plainify = def
255 , state_l10n = Loqualization EN_US
261 { keys_index :: Map DTC.Pos Terms
262 , keys_figure :: Map TL.Text (Map DTC.Pos (Maybe Title))
263 , keys_reference :: Map Ident About
265 instance Default Keys where
266 def = Keys mempty mempty mempty
270 keys :: a -> S.State Keys ()
271 instance KeysOf Body where
273 instance KeysOf (Tree BodyNode) where
276 BodySection{..} -> keys ts
277 BodyBlock b -> keys b
278 instance KeysOf DTC.Block where
280 BlockPara{} -> return ()
281 BlockBreak{} -> return ()
282 BlockToC{} -> return ()
283 BlockToF{} -> return ()
285 S.modify $ \s -> s{keys_index=
286 Map.insert pos terms $ keys_index s}
288 S.modify $ \s -> s{keys_figure=
290 type_ (Map.singleton pos mayTitle) $
292 BlockReferences{..} ->
293 S.modify $ \s -> s{keys_reference=
296 (DTC.id (r::DTC.Reference))
297 (DTC.about (r::DTC.Reference)))
301 -- * Class 'Html5ify'
302 class Html5ify a where
303 html5ify :: a -> Html5
304 instance Html5ify H.Markup where
305 html5ify = Compose . return
306 instance Html5ify Char where
307 html5ify = html5ify . H.toMarkup
308 instance Html5ify Text where
309 html5ify = html5ify . H.toMarkup
310 instance Html5ify TL.Text where
311 html5ify = html5ify . H.toMarkup
312 instance Html5ify String where
313 html5ify = html5ify . H.toMarkup
314 instance Html5ify Title where
315 html5ify (Title t) = html5ify t
316 instance Html5ify Ident where
317 html5ify (Ident i) = html5ify i
318 instance Html5ify Int where
319 html5ify = html5ify . show
320 instance Html5ify Nat where
321 html5ify (Nat n) = html5ify n
322 instance Html5ify Nat1 where
323 html5ify (Nat1 n) = html5ify n
324 instance Html5ify a => Html5ify (Maybe a) where
325 html5ify = foldMap html5ify
327 -- * Type 'BodyCursor'
328 -- | Cursor to navigate within a 'Body' according to many axis (like in XSLT).
329 type BodyCursor = Tree.Zipper BodyNode
330 instance Html5ify Body where
332 forM_ (Tree.zippers body) $ \z ->
333 forM_ (Tree.axis_repeat Tree.axis_following_sibling_nearest `Tree.runAxis` z) $
335 instance Html5ify BodyCursor
337 let Tree n _ts = Tree.current z in
339 BodyBlock BlockToC{..} -> do
340 H.nav ! HA.class_ "toc"
341 ! HA.id (attrify pos) $$ do
342 H.span ! HA.class_ "toc-name" $$
343 H.a ! HA.href ("#"<>attrify pos) $$ do
344 Loqualization loc <- liftStateMarkup $ S.gets state_l10n
345 Plain.l10n_Table_of_Contents loc
347 forM_ (Tree.axis_following_sibling `Tree.runAxis` z) $
349 BodyBlock b -> html5ify b
350 BodySection{..} -> do
352 notes <- liftStateMarkup $ S.gets state_notes
354 p <- posParent $ posAncestors pos
355 let (ns, as) = Map.updateLookupWithKey (\_ _ -> Nothing) p notes
359 Just (secNotes, state_notes) -> do
360 liftStateMarkup $ S.modify' $ \s -> s{state_notes}
362 H.section ! HA.class_ "section"
363 ! HA.id (attrify pos) $$ do
364 forM_ aliases html5ify
365 html5CommonAttrs attrs{classes="section-header":classes attrs} $
369 H.td ! HA.class_ "section-number" $$ do
370 html5SectionNumber $ DTC.posAncestors pos
371 H.td ! HA.class_ "section-title" $$ do
372 (case List.length $ DTC.posAncestors pos of
381 forM_ (Tree.axis_child `Tree.runAxis` z) $
383 notes <- liftStateMarkup $ S.gets state_notes
384 html5ify $ Map.lookup (posAncestors pos) notes
385 instance Html5ify [Anchor.Note] where
387 H.aside ! HA.class_ "notes" $$ do
391 forM_ (List.reverse notes) $ \Anchor.Note{..} ->
393 H.td ! HA.class_ "note-ref" $$ do
394 H.a ! HA.class_ "note-number"
395 ! HA.id ("note."<>attrify note_number)
396 ! HA.href ("#note."<>attrify note_number) $$ do
399 H.a ! HA.href ("#note-ref."<>attrify note_number) $$ do
402 html5ify note_content
403 instance Html5ify Block where
405 BlockPara para -> html5ify para
407 html5CommonAttrs attrs
408 { classes = "page-break":"print-only":classes attrs } $
410 H.p $$ " " -- NOTE: force page break
411 BlockToC{..} -> mempty -- NOTE: done in Html5ify BodyCursor
413 H.nav ! HA.class_ "tof"
414 ! HA.id (attrify pos) $$
415 H.table ! HA.class_ "tof" $$
419 html5CommonAttrs attrs
420 { classes = "figure":("figure-"<>type_):classes attrs
421 , DTC.id = Just $ Ident $ Plain.text def $ DTC.posAncestors pos
424 H.table ! HA.class_ "figure-caption" $$
428 then H.a ! HA.href ("#"<>attrify pos) $$ mempty
430 H.td ! HA.class_ "figure-number" $$ do
431 H.a ! HA.href ("#"<>attrify (DTC.posAncestorsWithFigureNames pos)) $$ do
433 html5ify $ DTC.posAncestorsWithFigureNames pos
434 forM_ mayTitle $ \title -> do
435 H.td ! HA.class_ "figure-colon" $$ do
436 unless (TL.null type_) $ do
437 Loqualization loc <- liftStateMarkup $ S.gets state_l10n
439 H.td ! HA.class_ "figure-title" $$ do
441 H.div ! HA.class_ "figure-content" $$ do
443 BlockIndex{pos} -> do
444 (allTerms,refsByTerm) <- liftStateMarkup $ S.gets $ (Map.! pos) . state_indexs
445 let chars = Anchor.termsByChar allTerms
446 H.div ! HA.class_ "index"
447 ! HA.id (attrify pos) $$ do
448 H.nav ! HA.class_ "index-nav" $$ do
449 forM_ (Map.keys chars) $ \char ->
450 H.a ! HA.href ("#"<>(attrify pos <> "." <> attrify char)) $$
452 H.dl ! HA.class_ "index-chars" $$
453 forM_ (Map.toList chars) $ \(char,terms) -> do
455 let i = attrify pos <> "." <> attrify char in
457 ! HA.href ("#"<>i) $$
460 H.dl ! HA.class_ "index-term" $$ do
461 forM_ terms $ \aliases -> do
463 H.ul ! HA.class_ "index-aliases" $$
464 forM_ (List.take 1 aliases) $ \term ->
465 H.li ! HA.id (attrifyIref term) $$
469 List.sortBy (compare `on` DTC.section . snd) $
470 (`foldMap` aliases) $ \words ->
472 path <- Anchor.pathFromWords words
473 Strict.maybe Nothing (Just . ((words,) <$>) . List.reverse) $
474 TreeMap.lookup path refsByTerm in
476 (<$> anchs) $ \(term,DTC.Anchor{..}) ->
477 H.a ! HA.class_ "index-iref"
478 ! HA.href ("#"<>attrifyIrefCount term count) $$
479 html5ify $ DTC.posAncestors section
480 BlockReferences{..} ->
481 html5CommonAttrs attrs
482 { classes = "references":classes attrs
483 , DTC.id = Just $ Ident $ Plain.text def $ DTC.posAncestors pos
489 html5ifyToC :: Maybe DTC.Nat -> BodyCursor -> Html5
490 html5ifyToC depth z =
491 let Tree n _ts = Tree.current z in
493 BodySection{..} -> do
495 H.table ! HA.class_ "toc-entry" $$
498 H.td ! HA.class_ "section-number" $$
499 html5SectionRef $ DTC.posAncestors pos
500 H.td ! HA.class_ "section-title" $$
501 html5ify $ cleanPlain $ unTitle title
502 when (maybe True (> Nat 1) depth && not (null sections)) $
505 html5ifyToC (depth >>= predNat)
511 `Tree.axis_filter_current` \case
512 Tree BodySection{} _ -> True
515 html5ifyToF :: [TL.Text] -> Html5
516 html5ifyToF types = do
517 figsByType <- liftStateMarkup $ S.gets state_figures
519 Map.foldMapWithKey (\ty -> ((ty,) <$>)) $
523 Map.intersection figsByType $
524 Map.fromList [(ty,()) | ty <- types]
525 forM_ (Map.toList figs) $ \(pos, (type_, title)) ->
527 H.td ! HA.class_ "figure-number" $$
528 H.a ! HA.href ("#"<>attrify pos) $$ do
530 html5ify $ DTC.posAncestors pos
532 H.td ! HA.class_ "figure-title" $$
533 html5ify $ cleanPlain $ unTitle ti
535 cleanPlain :: Plain -> Plain
538 Tree PlainIref{} ls -> cleanPlain ls
539 Tree PlainNote{} _ -> mempty
540 Tree n ts -> pure $ Tree n $ cleanPlain ts
542 instance Html5ify Para where
546 { classes="para":cls item
550 html5CommonAttrs attrs
551 { classes = "para":classes attrs
555 forM_ items $ \item ->
556 html5AttrClass (cls item) $
559 id_ = Just . Ident . Plain.text def . DTC.posAncestors
562 ParaArtwork{..} -> ["artwork", "artwork-"<>type_]
563 ParaQuote{..} -> ["quote", "quote-"<>type_]
567 instance Html5ify ParaItem where
569 ParaPlain p -> H.p $$ html5ify p
570 ParaArtwork{..} -> H.pre $$ do html5ify text
571 ParaQuote{..} -> H.div $$ do html5ify paras
572 ParaComment t -> html5ify $ H.Comment (H.String $ TL.unpack t) ()
576 forM_ items $ \ListItem{..} -> do
578 H.td ! HA.class_ "name" $$ do
581 H.td ! HA.class_ "value" $$
585 forM_ items $ \item -> do
587 H.dd $$ html5ify item
588 instance Html5ify [Para] where
589 html5ify = mapM_ html5ify
591 instance Html5ify Plain where
597 -- NOTE: gather adjacent PlainNotes
599 | (notes, rest) <- Seq.spanl (\case {Tree PlainNote{} _ -> True; _ -> False}) next -> do
600 H.sup ! HA.class_ "note-numbers" $$ do
602 forM_ notes $ \note -> do
611 instance Html5ify (Tree PlainNode)
612 where html5ify (Tree n ls) =
614 PlainBreak -> html5ify H.br
615 PlainText t -> html5ify t
616 PlainGroup -> html5ify ls
617 PlainB -> H.strong $$ html5ify ls
618 PlainCode -> H.code $$ html5ify ls
619 PlainDel -> H.del $$ html5ify ls
621 i <- liftStateMarkup $ do
622 i <- S.gets $ Plain.state_italic . state_plainify
625 (state_plainify s){Plain.state_italic=
628 H.em ! HA.class_ (if i then "even" else "odd") $$
633 (state_plainify s){Plain.state_italic=i}}
634 PlainSub -> H.sub $$ html5ify ls
635 PlainSup -> H.sup $$ html5ify ls
636 PlainSC -> H.span ! HA.class_ "smallcaps" $$ html5ify ls
637 PlainU -> H.span ! HA.class_ "underline" $$ html5ify ls
642 H.a ! HA.class_ "note-ref"
643 ! HA.id ("note-ref."<>attrify num)
644 ! HA.href ("#note."<>attrify num) $$
647 H.span ! HA.class_ "q" $$ do
648 Loqualization loc <- liftStateMarkup $ S.gets state_l10n
649 Plain.l10n_Quote (html5ify $ Tree PlainI ls) loc
651 H.a ! HA.class_ "eref"
652 ! HA.href (attrify href) $$
654 then html5ify $ unURL href
658 Nothing -> html5ify ls
660 H.span ! HA.class_ "iref"
661 ! HA.id (attrifyIrefCount term count) $$
664 H.a ! HA.class_ "ref"
665 ! HA.href ("#"<>attrify to) $$
670 refs <- liftStateMarkup $ S.gets state_references
671 case Map.lookup to refs of
674 H.span ! HA.class_ "rref-broken" $$
679 forM_ (List.take 1 titles) $ \(Title title) -> do
680 html5ify $ Tree PlainQ $
683 Just u -> pure $ Tree (PlainEref u) title
686 H.a ! HA.class_ "rref"
687 ! HA.href ("#rref."<>attrify to)
688 ! HA.id ("rref."<>attrify to<>maybe "" (\Anchor{..} -> "."<>attrify count) anchor) $$
692 instance Html5ify [Title] where
694 html5ify . fold . List.intersperse sep . toList
695 where sep = Title $ Seq.singleton $ tree0 $ PlainText " — "
696 instance Html5ify About where
698 html5CommasDot $ concat $
700 , html5ify <$> authors
701 , html5ify <$> maybeToList date
702 , html5ify <$> maybeToList editor
703 , html5ify <$> series
706 html5Titles :: [Title] -> [Html5]
707 html5Titles ts | null ts = []
708 html5Titles ts = [html5Title $ joinTitles ts]
710 joinTitles = fold . List.intersperse sep . toList
711 sep = Title $ Seq.singleton $ tree0 $ PlainText " — "
712 html5Title (Title title) =
713 html5ify $ Tree PlainQ $
716 Just u -> pure $ Tree (PlainEref u) title
717 instance Html5ify Serie where
718 html5ify s@Serie{id=id_, name} = do
719 Loqualization loc <- liftStateMarkup $ S.gets state_l10n
723 Plain.l10n_Colon loc :: Html5
727 Tree PlainEref{href} $
729 [ tree0 $ PlainText $ name
730 , tree0 $ PlainText $ Plain.l10n_Colon loc
731 , tree0 $ PlainText id_
733 instance Html5ify Entity where
734 html5ify Entity{..} = do
737 _ | not (TL.null email) ->
738 Tree (PlainEref $ URL $ "mailto:"<>email) $
739 pure $ tree0 $ PlainText name
742 pure $ tree0 $ PlainText name
743 _ -> tree0 $ PlainText name
748 instance Html5ify Words where
749 html5ify = html5ify . Anchor.plainifyWords
750 instance Html5ify Alias where
751 html5ify Alias{id=id_, ..} = do
752 H.a ! HA.class_ "alias"
753 ! HA.id (attrify id_) $$
755 instance Html5ify URL where
757 H.a ! HA.class_ "eref"
758 ! HA.href (attrify url) $$
760 instance Html5ify Date where
762 Loqualization loc <- liftStateMarkup $ S.gets state_l10n
763 Plain.l10n_Date date loc
764 instance Html5ify Reference where
765 html5ify Reference{id=id_, ..} =
767 H.td ! HA.class_ "reference-key" $$
768 html5ify $ Tree PlainRref{anchor=Nothing, to=id_} Seq.empty
769 H.td ! HA.class_ "reference-content" $$ do
771 rrefs <- liftStateMarkup $ S.gets state_rrefs
772 case Map.lookup id_ rrefs of
775 H.span ! HA.class_ "reference-rrefs" $$
777 (<$> List.reverse anchs) $ \Anchor{..} ->
778 H.a ! HA.class_ "reference-rref"
779 ! HA.href ("#rref."<>attrify id_<>"."<>attrify count) $$
780 html5ify $ DTC.posAncestors section
781 instance Html5ify PosPath where
789 Text.intercalate "." $
790 Text.pack . show . snd <$> as
791 instance Html5ify Plain.Plain where
793 sp <- liftStateMarkup $ S.gets state_plainify
794 let (t,sp') = Plain.runPlain p sp
796 liftStateMarkup $ S.modify $ \s -> s{state_plainify=sp'}
798 html5CommasDot :: [Html5] -> Html5
799 html5CommasDot [] = pure ()
800 html5CommasDot hs = do
801 sequence_ $ List.intersperse ", " hs
804 html5AttrClass :: [TL.Text] -> Html5 -> Html5
805 html5AttrClass = \case
809 (H.AddCustomAttribute "class"
810 (H.String $ TL.unpack $ TL.unwords cls) <$>) .
813 html5AttrId :: Ident -> Html5 -> Html5
814 html5AttrId (Ident id_) =
816 (H.AddCustomAttribute "id"
817 (H.String $ TL.unpack id_) <$>) .
820 html5CommonAttrs :: CommonAttrs -> Html5 -> Html5
821 html5CommonAttrs CommonAttrs{id=id_, ..} =
822 html5AttrClass classes .
823 maybe Cat.id html5AttrId id_
825 html5SectionNumber :: PosPath -> Html5
826 html5SectionNumber = go mempty
828 go :: PosPath -> PosPath -> Html5
830 case Seq.viewl next of
831 Seq.EmptyL -> pure ()
832 a@(_n,rank) Seq.:< as -> do
833 H.a ! HA.href ("#"<>attrify (prev Seq.|>a)) $$
835 when (not (null as) || null prev) $ do
839 html5SectionRef :: PosPath -> Html5
841 H.a ! HA.href ("#"<>attrify as) $$
845 instance Attrify Anchor where
846 attrify Anchor{..} = attrify section <> "." <> attrify count
847 instance Attrify Plain.Plain where
848 attrify p = attrify t
849 where (t,_) = Plain.runPlain p def
850 instance Attrify PosPath where
851 attrify = attrify . plainify
852 instance Attrify DTC.Pos where
853 attrify = attrify . DTC.posAncestors
855 attrifyIref :: Words -> H.AttributeValue
857 "iref" <> "." <> attrify (Anchor.plainifyWords term)
858 attrifyIrefCount :: Words -> Nat1 -> H.AttributeValue
859 attrifyIrefCount term count =
861 <> "." <> attrify (Anchor.plainifyWords term)
862 <> "." <> attrify count
866 ( Plain.L10n msg lang
867 , Plain.L10n TL.Text lang
868 ) => L10n msg lang where
869 l10n_Header_Address :: FullLocale lang -> msg
870 l10n_Header_Date :: FullLocale lang -> msg
871 l10n_Header_Version :: FullLocale lang -> msg
872 l10n_Header_Origin :: FullLocale lang -> msg
873 l10n_Header_Source :: FullLocale lang -> msg
874 instance L10n Html5 EN where
875 l10n_Header_Address _loc = "Address"
876 l10n_Header_Date _loc = "Date"
877 l10n_Header_Origin _loc = "Origin"
878 l10n_Header_Source _loc = "Source"
879 l10n_Header_Version _loc = "Version"
880 instance L10n Html5 FR where
881 l10n_Header_Address _loc = "Adresse"
882 l10n_Header_Date _loc = "Date"
883 l10n_Header_Origin _loc = "Origine"
884 l10n_Header_Source _loc = "Source"
885 l10n_Header_Version _loc = "Version"
887 instance Plain.L10n Html5 EN where
888 l10n_Colon loc = html5ify (Plain.l10n_Colon loc :: TL.Text)
889 l10n_Table_of_Contents loc = html5ify (Plain.l10n_Table_of_Contents loc :: TL.Text)
890 l10n_Date date loc = html5ify (Plain.l10n_Date date loc :: TL.Text)
891 l10n_Quote msg _loc = do
892 depth <- liftStateMarkup $ S.gets $ Plain.state_quote . state_plainify
893 let (o,c) :: (Html5, Html5) =
894 case unNat depth `mod` 3 of
899 setDepth $ succNat depth
905 liftStateMarkup $ S.modify' $ \s ->
906 s{state_plainify=(state_plainify s){Plain.state_quote=d}}
907 instance Plain.L10n Html5 FR where
908 l10n_Colon loc = html5ify (Plain.l10n_Colon loc :: TL.Text)
909 l10n_Table_of_Contents loc = html5ify (Plain.l10n_Table_of_Contents loc :: TL.Text)
910 l10n_Date date loc = html5ify (Plain.l10n_Date date loc :: TL.Text)
911 l10n_Quote msg _loc = do
912 depth <- liftStateMarkup $ S.gets $ Plain.state_quote . state_plainify
913 let (o,c) :: (Html5, Html5) =
914 case unNat depth `mod` 3 of
919 setDepth $ succNat depth
925 liftStateMarkup $ S.modify' $ \s ->
926 s{state_plainify=(state_plainify s){Plain.state_quote=d}}