forked from Eelis/cxxdraft-htmlgen
-
Notifications
You must be signed in to change notification settings - Fork 0
/
SectionPages.hs
257 lines (238 loc) · 11.9 KB
/
SectionPages.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
{-# OPTIONS_GHC -fno-warn-tabs #-}
{-# LANGUAGE OverloadedStrings, RecordWildCards, TupleSections, ViewPatterns #-}
module SectionPages
( writeSectionFiles
, writeSingleSectionFile
, writeFiguresFile
, writeFigureFiles
, writeTablesFile
, writeTableFiles
, writeIndexFiles
, writeFootnotesFile
, writeCssFile
, writeXrefDeltaFiles
) where
import Prelude hiding ((++), (.), writeFile)
import System.Directory (createDirectoryIfMissing)
import Control.Monad (when, forM_)
import Control.Arrow (first)
import Data.Maybe (fromJust)
import System.Process (readProcess)
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Data.Text.Lazy.Builder as TextBuilder
import Pages (writePage, pageContent, pagePath, PageStyle(..), fileContent, outputDir, Link(..))
import Render (render, concatRender, simpleRender2, renderFig,
defaultRenderContext, renderTab, RenderContext(..), Page(..),linkToSection, squareAbbr,
secnum, renderLatexParas, isSectionPage, parentLink, renderIndex)
import Document
import Util (urlChars, (++), (.), h, anchor, xml, Anchor(..), Text, writeFile, intercalateBuilders)
renderParagraph :: RenderContext -> TextBuilder.Builder
renderParagraph ctx@RenderContext{nearestEnclosing=Left Paragraph{..}, draft=Draft{..}} =
(case paraNumber of
Just i -> renderNumbered (Text.pack $ show i)
Nothing -> id)
$ (if paraInItemdescr then xml "div" [("class", "itemdescr")] else id)
$ (sourceLink
++ renderLatexParas paraElems ctx'{extraIndentation=if paraInItemdescr then 12 else 0})
-- the 12 here must match div.itemdescr's margin-left value in mm
where
urlBase = Text.replace "/commit/" "/tree/" commitUrl ++ "/source/"
sourceLink :: TextBuilder.Builder
sourceLink
| Just SourceLocation{..} <- paraSourceLoc =
xml "div" [("class", "sourceLinkParent")]
$ simpleRender2 $ anchor
{ aClass = "sourceLink"
, aText = "#"
, aHref = urlBase ++ Text.pack (sourceFile ++ "#L" ++ show sourceLine) }
| otherwise = ""
renderNumbered :: Text -> TextBuilder.Builder -> TextBuilder.Builder
renderNumbered n =
let
idTag = if isSectionPage (page ctx) then [("id", mconcat (idPrefixes ctx) ++ n)] else []
a = anchor
{ aClass = "marginalized"
, aHref =
if isSectionPage (page ctx)
then "#" ++ urlChars (mconcat (idPrefixes ctx)) ++ n
else "SectionToSection/" ++ urlChars (abbreviation paraSection) ++ "#" ++ n
, aText = TextBuilder.fromText n }
classes = "para" ++
(if all (not . normative) (paraElems >>= sentences >>= sentenceElems)
then " nonNormativeOnly"
else "")
in
xml "div" (("class", classes) : idTag) .
(xml "div" [("class", "marginalizedparent")] (render a ctx') ++)
ctx' = case paraNumber of
Just n -> ctx{ idPrefixes = idPrefixes ctx ++ [Text.pack (show n) ++ "."] }
Nothing -> ctx
renderParagraph _ = undefined
renderSection :: RenderContext -> Maybe Section -> Bool -> Section -> (TextBuilder.Builder, Bool)
renderSection context specific parasEmitted s@Section{..}
| full = (, True) $
idDiv $ header ++
mconcat (map
(\p -> renderParagraph (context{nearestEnclosing=Left p,idPrefixes=if parasEmitted then [secOnPage ++ "-"] else []}))
paragraphs) ++
(if null sectionFootnotes then "" else "<div class='footnoteSeparator'></div>") ++
concatRender sectionFootnotes context{nearestEnclosing=Right s} ++
mconcat (fst . renderSection context Nothing True . subsections)
| not anysubcontent = ("", False)
| otherwise =
( header ++
mconcat (fst . renderSection context specific False . subsections)
, anysubcontent )
where
idDiv
| specific == Just s = id
| otherwise = xml "div" [("id", secOnPage), ("class", "section")]
secOnPage :: Text
secOnPage = case page context of
SectionPage parent -> parentLink parent abbreviation
_ -> abbreviation
full = specific == Nothing || specific == Just s
header = sectionHeader (min 4 $ 1 + length parents) s
(if specific == Nothing && isSectionPage (page context) then "#" ++ urlChars secOnPage else "")
abbr context
abbr
| specific == Just s && not (null parents)
= anchor
| Just sp <- specific, sp /= s, not (null parents)
= anchor{aHref = "SectionToSection/" ++ urlChars abbreviation ++ "#" ++ parentLink s (Document.abbreviation sp)}
| otherwise = linkToSection
(if null parents then SectionToToc else SectionToSection)
abbreviation
anysubcontent =
or $ map (snd . renderSection context specific True)
$ subsections
sectionFileContent :: PageStyle -> TextBuilder.Builder -> TextBuilder.Builder -> Text
sectionFileContent sfs title body = pageContent sfs $ fileContent pathHome title sectionPageCss body
where
pathHome = if sfs == InSubdir then "../" else ""
sectionPageCss =
"<link rel='stylesheet' type='text/css' href='" ++ pathHome ++ "expanded.css' title='Normal'/>" ++
"<link rel='alternate stylesheet' type='text/css' href='" ++ pathHome ++ "colored.css' title='Notes and examples colored'/>" ++
"<link rel='alternate stylesheet' type='text/css' href='" ++ pathHome ++ "normative-only.css' title='Notes and examples hidden'/>"
writeSectionFile :: FilePath -> PageStyle -> TextBuilder.Builder -> TextBuilder.Builder -> IO ()
writeSectionFile n sfs title body = writePage n sfs (sectionFileContent sfs title body)
sectionHeader :: Int -> Section -> Text -> Anchor -> RenderContext -> TextBuilder.Builder
sectionHeader hLevel s@Section{..} secnumHref abbr_ref ctx
| isDef = xml "h4" [("style", "margin-bottom:3pt")] $ num ++ abbrR ++ name
| abbreviation == "bibliography" = h hLevel name
| otherwise = h hLevel $ num ++ " " ++ name ++ " " ++ abbrR
where
num = secnum secnumHref s
abbrR = simpleRender2 abbr_ref{aClass = "abbr_ref", aText = squareAbbr False abbreviation}
name = render sectionName ctx{inSectionTitle=True}
isDef = isDefinitionSection sectionKind
writeFiguresFile :: PageStyle -> Draft -> IO ()
writeFiguresFile sfs draft = writeSectionFile "fig" sfs "14882: Figures" $
"<h1>Figures <a href='SectionToToc/fig' class='abbr_ref'>[fig]</a></h1>"
++ mconcat (uncurry r . figures draft)
where
r :: Paragraph -> Figure -> TextBuilder.Builder
r p f@Figure{..} =
renderFig True f ("./SectionToSection/" ++ urlChars figureAbbr) False True ctx
where ctx = defaultRenderContext{draft=draft, nearestEnclosing=Left p, page=FiguresPage}
writeTablesFile :: PageStyle -> Draft -> IO ()
writeTablesFile sfs draft = writeSectionFile "tab" sfs "14882: Tables" $
"<h1>Tables <a href='SectionToToc/tab' class='abbr_ref'>[tab]</a></h1>"
++ mconcat (uncurry r . tables draft)
where
r :: Paragraph -> Table -> TextBuilder.Builder
r p t@Table{tableSection=Section{..}, ..} =
renderTab True t ("./SectionToSection/" ++ urlChars tableAbbr) False True ctx
where ctx = defaultRenderContext{
draft = draft,
nearestEnclosing = Left p,
page = TablesPage,
idPrefixes = [fromJust (Text.stripPrefix "tab:" tableAbbr) ++ "-"]}
writeFootnotesFile :: PageStyle -> Draft -> IO ()
writeFootnotesFile sfs draft = writeSectionFile "footnotes" sfs "14882: Footnotes" $
"<h1>List of Footnotes</h1>"
++ mconcat (uncurry r . footnotes draft)
where
r :: Section -> Footnote -> TextBuilder.Builder
r s fn = render fn defaultRenderContext{draft=draft, nearestEnclosing = Right s, page=FootnotesPage}
writeSingleSectionFile :: PageStyle -> Draft -> String -> IO ()
writeSingleSectionFile sfs draft abbr = do
let Just section@Section{..} = Document.sectionByAbbr draft (Text.pack abbr)
let baseFilename = Text.unpack abbreviation
writeSectionFile baseFilename sfs (squareAbbr False abbreviation) $ mconcat $ fst . renderSection (defaultRenderContext{draft=draft,page=SectionPage section}) (Just section) False . chapters draft
putStrLn $ " " ++ baseFilename
writeTableFiles :: PageStyle -> Draft -> IO ()
writeTableFiles sfs draft =
forM_ (snd . tables draft) $ \tab@Table{..} -> do
let
context = defaultRenderContext{draft=draft, page=TablePage tab, nearestEnclosing=Right tableSection}
header :: Section -> TextBuilder.Builder
header sec = sectionHeader (min 4 $ 1 + length (parents sec)) sec "" anchor{aHref=href} context
where href="SectionToSection/" ++ urlChars (abbreviation sec) ++ "#" ++ urlChars tableAbbr
headers = mconcat $ map header $ reverse $ tableSection : parents tableSection
writeSectionFile (Text.unpack tableAbbr) sfs (TextBuilder.fromText $ "[" ++ tableAbbr ++ "]") $
headers ++ renderTab True tab "" True False context
writeFigureFiles :: PageStyle -> Draft -> IO ()
writeFigureFiles sfs draft =
forM_ (snd . figures draft) $ \fig@Figure{..} -> do
let
context = defaultRenderContext{draft=draft, page=FigurePage fig, nearestEnclosing=Right figureSection}
header :: Section -> TextBuilder.Builder
header sec = sectionHeader (min 4 $ 1 + length (parents sec)) sec "" anchor{aHref=href} context
where href="SectionToSection/" ++ urlChars (abbreviation sec) ++ "#" ++ urlChars figureAbbr
headers = mconcat $ map header $ reverse $ figureSection : parents figureSection
writeSectionFile (Text.unpack figureAbbr) sfs (TextBuilder.fromText $ "[" ++ figureAbbr ++ "]") $
headers ++ renderFig True fig "" True False context
writeSectionFiles :: PageStyle -> Draft -> [IO ()]
writeSectionFiles sfs draft = flip map (zip names contents) $ \(n, content) -> do
when (sfs == InSubdir) $ createDirectoryIfMissing True (outputDir ++ n)
writeFile (pagePath n sfs) content
where
secs = Document.sections draft
renSec section@Section{..} = (Text.unpack abbreviation, sectionFileContent sfs title body)
where
title = squareAbbr False abbreviation
body = mconcat $ fst . renderSection (defaultRenderContext{draft=draft,page=SectionPage section}) (Just section) False . chapters draft
fullbody = mconcat $ fst . renderSection defaultRenderContext{draft=draft, page=FullPage} Nothing True . chapters draft
fullfile = ("full", sectionFileContent sfs "14882" fullbody)
files = fullfile : map renSec secs
names = fst . files
contents = snd . files
writeIndexFile :: PageStyle -> Draft -> String -> IndexTree -> IO ()
writeIndexFile sfs draft cat index =
writeSectionFile cat sfs ("14882: " ++ indexCatName cat) $
h 1 (indexCatName cat) ++ renderIndex defaultRenderContext{page=IndexPage (Text.pack cat), draft=draft} index
writeIndexFiles :: PageStyle -> Draft -> Index -> [IO ()]
writeIndexFiles sfs draft index = flip map (Map.toList index) $ uncurry (writeIndexFile sfs draft) . first Text.unpack
writeCssFile :: IO ()
writeCssFile = do
base <- Text.pack . readFile "14882.css"
let
replaceFonts =
Text.replace
".MJXc-TeX-sans-R {font-family: MJXc-TeX-sans-R,MJXc-TeX-sans-Rw}"
".MJXc-TeX-sans-R {font-family: 'Noto Sans'; font-size: 10pt; }" .
Text.replace
".MJXc-TeX-type-R {font-family: MJXc-TeX-type-R,MJXc-TeX-type-Rw}"
".MJXc-TeX-type-R {font-family: 'Noto Sans Mono'; font-size: 10pt; }" .
Text.replace
".MJXc-TeX-main-R {font-family: MJXc-TeX-main-R,MJXc-TeX-main-Rw}"
".MJXc-TeX-main-R {}" .
Text.replace
".MJXc-TeX-math-I {font-family: MJXc-TeX-math-I,MJXc-TeX-math-Ix,MJXc-TeX-math-Iw}"
".MJXc-TeX-math-I {font-style: italic}" .
Text.replace
".MJXc-TeX-main-I {font-family: MJXc-TeX-main-I,MJXc-TeX-main-Ix,MJXc-TeX-main-Iw}"
".MJXc-TeX-main-I {font-style: italic}"
-- Replace fonts to make sure code in formulas matches code in code blocks, etc.
mjx <- Text.replace "display: block" "display: block;background:inherit" . replaceFonts . Text.pack .
readProcess "tex2html" ["--css", ""] ""
writeFile (outputDir ++ "/14882.css") (base ++ mjx)
writeXrefDeltaFiles :: PageStyle -> Draft -> [IO ()]
writeXrefDeltaFiles sfs draft = flip map (xrefDelta draft) $ \(from, to) ->
writeSectionFile (Text.unpack from) sfs (squareAbbr False from) $
if to == []
then "Subclause " ++ squareAbbr False from ++ " was removed."
else "See " ++ intercalateBuilders ", " (flip render ctx . to) ++ "."
where ctx = defaultRenderContext{draft=draft, page=XrefDeltaPage}