Bool
isOnlySpace (RawLatexElement x) = triml [x] == []
isOnlySpace _ = False
parsePara :: LaTeX -> [RawTexPara]
parsePara u = RawTexPara . dropWhile isOnlySpace . fmap f . splitElems (trim (filter (not . kill) u))
where
kill (TeXComm "hline" _ []) = True
kill (TeXComm "capsep" _ []) = True
kill (TeXComm "endhead" _ _) = True
kill _ = False
f :: LaTeXUnit -> RawElement
f e@(TeXEnv k a stuff)
| isFigure e
, [(FixArg, rawFigureName), (FixArg, [TeXRaw rawFigureAbbr]), (FixArg, [TeXRaw figureFile])] <- a
= RawFigure{rawFigureSvg=loadFigure figureFile, ..}
| k == "formula", [(FixArg, [TeXRaw rawFormulaAbbr])] <- a = RawFormula{rawFormulaContent = stuff, ..}
| isTable e
, ((_, cap) : (_, [TeXRaw abbr]) : (_, y) : _) <- a
= RawTable
{ rawTableCaption = cap
, rawColumnSpec = parseColspec y
, rawTableAbbr = "tab:" ++ abbr
, rawTableBody = breakMultiCols $ parseTable stuff }
| isTable e = error $ "other table: " ++ show e
| isTabbing e = RawTabbing stuff
| isBnf e = RawBnf (if "nc" `isPrefixOf` k then drop 2 k else k) stuff
| Just ek <- isEnumerate e = RawEnumerated ek (parseItems stuff)
| isCodeblock e = RawCodeblock e
| k `elem` ["note", "defnote", "tailnote"] =
let label = case a of [(FixArg, [TeXRaw x])] -> x; _ -> "Note"
in RawNote label $ parsePara stuff
| k `elem` ["example", "tailexample"] = RawExample $ parsePara stuff
| k == "itemdecl" || k == "minipage" || k == "indexeditemdecl" = RawLatexElement e
| k == "itemdescr" = RawItemdescr $ parsePara stuff
f x = RawLatexElement x
splitElems :: LaTeX -> [LaTeX]
splitElems [] = []
splitElems (x:xs)
| TeXRaw (textStripInfix "\n\n" -> Just (a, (Text.stripStart -> b))) <- x =
(if a == "" then ([] :) else ([TeXRaw a] :)) $
splitElems (if b == "" then xs else TeXRaw b : xs)
| otherwise = case splitElems xs of
[] -> [[x]]
a:b -> ((x:a):b)
class ExtractFootnotes a where extractFootnotes :: a -> (a, [RawFootnote])
instance ExtractFootnotes LaTeX where
extractFootnotes [] = ([], [])
extractFootnotes (TeXRaw x : t@(TeXEnv "footnote" _ _ : _))
= (TeXRaw (Text.stripEnd x) : t', ft)
where (t', ft) = extractFootnotes t
-- stripEnd here implements the footnote's \unskip
extractFootnotes (h:t) = (h' : t', fh ++ ft)
where
(h', fh) = extractFootnotes h
(t', ft) = extractFootnotes t
instance ExtractFootnotes LaTeXUnit where
extractFootnotes (TeXEnv "footnote" [] content) =
(TeXComm "footnoteref" "" [], [RawFootnote $ parsePara content])
extractFootnotes (TeXComm "footnotemark" _ []) =
(TeXComm "footnoteref" "" [], [])
extractFootnotes (TeXComm "footnotetext" _ [(_, content)]) =
(TeXRaw "" {- todo.. -}, [RawFootnote $ parsePara content])
extractFootnotes (TeXComm a ws [(FixArg, content)]) =
first (\c -> TeXComm a ws [(FixArg, c)]) (extractFootnotes content)
extractFootnotes (TeXEnv env args content) = first (TeXEnv env args) (extractFootnotes content)
extractFootnotes other = (other, [])
parseParas :: LaTeX -> ([RawParagraph], [RawFootnote], LaTeX {- rest -})
parseParas (break isParasEnd -> (extractFootnotes -> (stuff, fs), rest))
= (collectParas stuff, fs, rest)
where
collectParas :: LaTeX -> [RawParagraph]
collectParas (t@(TeXEnv "indexeditemdecl" _ _) : more) =
RawParagraph False False (parsePara [t]) Nothing : collectParas more
collectParas (t@(TeXEnv "itemdecl" _ _) : more) =
RawParagraph False False (parsePara [t]) Nothing : collectParas more
collectParas (TeXEnv "itemdescr" _ desc : more) =
map (\p -> p{rawParaInItemdescr=True}) (collectParas desc)
++ collectParas more
collectParas (TeXComm "pnum" _
[ (FixArg, [TeXRaw (Text.unpack -> file)])
, (FixArg, [TeXRaw (Text.unpack -> read -> lineNr)])] : more) =
(\(p : x) -> p{paraNumbered=True, rawParaSourceLoc=Just (SourceLocation file lineNr)} : x)
(collectParas more)
collectParas (TeXComm "pnum" _ [] : more) =
(\(p : x) -> p{paraNumbered=True, rawParaSourceLoc=Nothing} : x)
(collectParas more)
collectParas [] = []
collectParas x = (if null p then id else (RawParagraph False False p Nothing :)) (collectParas more)
where (parsePara -> p, more) = break isParaEnd x
parseSections :: Int -> LaTeX -> [LinearSection]
parseSections level (TeXComm "textlarger" _ _ : more) = parseSections level more
parseSections level
(TeXComm c _ args : (parseParas -> (lsectionParagraphs, lsectionFootnotes, more)))
| ((FixArg, isJustRaw -> fromJust -> lsectionAbbreviation), (FixArg, lsectionName), lsectionKind, level') <- case (c, args) of
("normannex", [abbr, name]) -> (abbr, name, NormativeAnnexSection, level)
("infannex", [abbr, name]) -> (abbr, name, InformativeAnnexSection, level)
("definition", [name, abbr]) -> (abbr, name, DefinitionSection (level + 1), level)
("rSec", [(FixArg, [TeXRaw (Text.unpack -> read -> l)]), abbr, name]) ->
(abbr, name, NormalSection l, l)
_ -> error $ "not a section command: " ++ show (c, args)
= LinearSection{..} : parseSections level' more
parseSections _ [] = []
parseSections l (x:xx)
| TeXRaw t <- x, all isSpace (Text.unpack t) = parseSections l xx
| otherwise = error $ "parseSections: " ++ show x
parseTable :: LaTeX -> [Row [RawTexPara]]
parseTable latex
| triml latex == [] = []
| triml row == [] = parseTable $ tail rest
| hasCommand (== "endfirsthead") row = parseTable $ findEndHead rest
| hasCommand (`elem` ["caption", "bottomline"]) row = parseTable rest
| otherwise = makeRow row : parseTable rest
where
(row, rest) = break (== TeXLineBreak) latex
findEndHead l
| row' == [] = findEndHead $ tail rest'
| hasCommand (== "endhead") row' = l
| otherwise = findEndHead rest'
where
(row', rest') = break (== TeXLineBreak) l
columnBreakCell :: Cell [RawTexPara]
columnBreakCell = Cell Normal [RawTexPara [RawLatexElement (TeXComm "columnbreak" "" [])]]
isColumnBreakCell :: Cell [RawTexPara] -> Bool
isColumnBreakCell (Cell Normal [RawTexPara [RawLatexElement (TeXComm "columnbreak" _ [])]]) = True
isColumnBreakCell _ = False
makeRectangular :: a -> [[a]] -> [[a]]
makeRectangular filler rows = (take numCols . (++ repeat filler)) . rows
where numCols = maximum (length . rows)
-- Todo: Remove this when the bugs in Chrome's collapsed border rendering are fixed.
breakMultiCols :: [Row [RawTexPara]] -> [Row [RawTexPara]]
-- implements the multicolfloattable environment's \columnbreak, which is left intact by parseTable
breakMultiCols rows
| all (\Row{..} -> length cells == 1 && rowSep == NoSep) rows =
Row NoSep . makeRectangular (Cell Normal []) (transpose $ splitOn isColumnBreakCell $ separateColumnBreaks $ (head . cells) . rows)
| otherwise = rows
where
separateColumnBreaks :: [Cell [RawTexPara]] -> [Cell [RawTexPara]]
separateColumnBreaks = concatMap f
where
f :: Cell [RawTexPara] -> [Cell [RawTexPara]]
f c@Cell{..} | [RawTexPara (RawLatexElement (TeXComm "columnbreak" _ []) : rest)] <- content =
[columnBreakCell, c{content = [RawTexPara rest]}]
| otherwise = [c]
makeRow :: LaTeX -> Row [RawTexPara]
makeRow l = Row sep $ makeRowCells l
where
sep
| hasCommand (== "hline") l = RowSep
| hasCommand (== "capsep") l = CapSep
| hasCommand (== "cline") l = Clines $ clines $ lookForCommand "cline" l
| otherwise = NoSep
clines [] = []
clines (([(FixArg, [TeXRaw c])]) : rest) = (begin, end) : clines rest
where
(begin', end') = Text.breakOn "-" c
begin = read $ Text.unpack begin' :: Int
end = read $ Text.unpack $ Text.tail end' :: Int
clines other = error $ "Unexpected \\clines syntax: " ++ show other
parseWidth :: LaTeX -> (Maybe Text, LaTeX)
parseWidth (TeXRaw "" : x) = parseWidth x
parseWidth (TeXBraces [TeXRaw x] : rest) = (Just x, rest)
parseWidth (TeXBraces [TeXRaw x, TeXComm "hsize" "" []] : rest) =
(Just $ Text.pack (show (round ((read ("0" ++ Text.unpack x) :: Double) * 100) :: Int)) ++ "%", rest)
parseWidth (TeXBraces _ : rest) = (Nothing, rest) -- remaining cases unsupported for now
parseWidth x = (Nothing, x)
parseColspec :: LaTeX -> [ColumnSpec]
parseColspec = \x -> case x of
[] -> []
TeXRaw (Text.unpack -> '|' : z) : y -> go (TeXRaw (Text.pack z) : y)
_ -> go x
where
go :: LaTeX -> [ColumnSpec]
go [] = []
go [TeXRaw "|"] = []
go (TeXRaw "@" : TeXBraces _ : x) = go x -- unimplemented
go (TeXRaw ">" : TeXBraces _ : x) = go x -- unimplemented
go (TeXRaw "" : y) = go y
go (TeXRaw (Text.uncons -> Just (letter, rest)) : y)
| letter == ' ' = go (TeXRaw rest : y)
| letter == '|' = mapHead (\(ColumnSpec x _ z) -> ColumnSpec x True z) $ go (TeXRaw rest : y)
| otherwise =
let (w, rest') = parseWidth (TeXRaw rest : y)
in ColumnSpec (colClass letter) False w : go rest'
go x = error ("parseColspec: " ++ show x)
colClass :: Char -> TextAlignment
colClass x | x `elem` ['l', 'm', 'x'] = AlignLeft
colClass 'p' = Justify
colClass 'r' = AlignRight
colClass 'c' = AlignCenter
colClass other = error $ "Unexpected column type " ++ (other : [])
makeRowCells :: LaTeX -> [Cell [RawTexPara]]
makeRowCells [] = []
makeRowCells latex =
case rest of
[] -> [makeCell cell]
_ : r ->
(makeCell $ cell <> [TeXRaw cell']) : makeRowCells (TeXRaw rest'' : r)
where
(cell, rest) = break isColEnd latex
isColEnd (TeXRaw c) = isJust $ Text.find (== '&') c
isColEnd _ = False
(cell', rest') = Text.break (== '&') $ getText rest
rest'' = Text.drop 1 rest'
getText (TeXRaw s : _) = s
getText other = error $ "Didn't expect " ++ show other
makeCell content
| [[(FixArg, [TeXRaw w]), (FixArg, cs), (FixArg, content')]] <- lookForCommand "multicolumn" content =
Cell (Multicolumn (read $ Text.unpack w) (head $ parseColspec cs)) $ parsePara content'
| otherwise =
Cell Normal $ parsePara content
rmExplSyntax :: Text -> Text
rmExplSyntax = Text.unlines . f . Text.lines
where
f [] = []
f ("\\ExplSyntaxOn" : (dropWhile (/= "\\ExplSyntaxOff") -> (_ : x))) = f x
f (h : t) = h : f t
loadMacros :: Text -> IO Macros
loadMacros extraMacros =
(initialMacros ++)
. snd
. doParse initialMacros
. replace "\\indeximpldef{" "\\index[impldefindex]{"
. textSubRegex (mkRegex "\\\\penalty[0-9]+{}") ""
. textSubRegex (mkRegex "\\\\verbtocs{[\\a-zA-Z]*}\\|[^|]*\\|") ""
. rmExplSyntax
. (++ extraMacros)
. mconcat
. mapM readFile
["config.tex", "macros.tex", "tables.tex"]
loadXrefDelta :: IO XrefDelta
loadXrefDelta = do
(tex, _, _) <- Parser.parseString initialContext . Text.unpack . readFile "xrefdelta.tex"
let lfc c = lookForCommand c tex
return $
[ (fromJust $ isJustRaw $ snd from, [snd to])
| [from, to] <- lfc "movedxrefs" ] ++
[ (fromJust $ isJustRaw $ snd from, (:[]) . TeXComm "ref" "" . (:[]) . tos)
| from : tos <- lfc "movedxref" ++ lfc "movedxrefii" ++ lfc "movedxrefiii" ] ++
[ (abbr, [])
| [(_, [TeXRaw abbr])] <- lfc "removedxref" ] ++
[ (abbr, [[TeXComm "ref" "" [(FixArg, [TeXRaw ("depr." ++ abbr)])]]])
| [(_, [TeXRaw abbr])] <- lfc "deprxref" ]
================================================
FILE: Render.hs
================================================
{-# OPTIONS_GHC -fno-warn-tabs #-}
{-# LANGUAGE
OverloadedStrings,
RecordWildCards,
TupleSections,
ViewPatterns,
NamedFieldPuns,
LambdaCase,
TypeSynonymInstances,
FlexibleInstances #-}
module Render (
Render(render), concatRender, renderTab, renderFig, renderIndex, simpleRender, simpleRender2, squareAbbr,
linkToSection, secnum, Page(..), parentLink, abbrHref,
defaultRenderContext, isSectionPage,
RenderContext(..), renderLatexParas
) where
import Load14882 (parseIndex) -- todo: bad
import Document (
CellSpan(..), Cell(..), RowSepKind(..), Row(..), Element(..), Draft(..), Footnote(..),
TeXPara(..), Sentence(..), Abbreviation, sectionByAbbr, footnotes, ColumnSpec(..),
Section(..), Chapter(..), Table(..), Figure(..), Sections(..), figures, formulas, tables, Item(..),
IndexComponent(..), IndexTree, IndexNode(..), IndexKind(..), IndexEntry(..), Formula(..),
IndexPath, indexKeyContent, tableByAbbr, figureByAbbr, formulaByAbbr, Paragraph(..), Note(..), Example(..),
chapterOfSection)
import LaTeXBase (LaTeX, LaTeXUnit(..), ArgKind(..), MathType(..), lookForCommand, concatRaws,
renderLaTeX, trim, isMath, isCodeblock, texStripPrefix, texSpan, mapTeX, mapCommandName)
import qualified Data.IntMap as IntMap
import Data.Text (isPrefixOf)
import qualified Data.Text.Lazy.Builder as TextBuilder
import Debug.Trace (trace)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LazyText
import qualified Text.HTML.TagSoup as Soup
import Data.Char (isAlpha, isSpace, isAlphaNum, toLower, isUpper, ord, isDigit, toUpper)
import Control.Arrow (second)
import qualified Prelude ()
import qualified MathJax
import Prelude hiding (take, (.), (++), writeFile)
import Data.List (find, nub, intersperse, (\\), sortOn, dropWhileEnd)
import qualified Data.Map as Map
import Data.Maybe (isJust, fromJust)
import Pages (Link(..))
import Sentences (linkifyFullStop)
import Util ((.), (++), replace, Text, xml, spanTag, anchor, Anchor(..), greekAlphabet,
urlChars, intercalateBuilders, replaceXmlChars, spanJust, h, partitionBy, mapHead)
import CxxParser (parseCppDirective, parseLiteral, parseComment)
kill, literal :: [String]
kill = words $
"clearpage renewcommand newcommand enlargethispage noindent indent vfill pagebreak setlength " ++
"caption capsep continuedcaption bottomline hline rowsep hspace endlist cline " ++
"hfill nocorr small endhead kill footnotesize rmfamily microtypesetup nobreak nolinebreak " ++
"topline FlushAndPrintGrammar left right protect = ! @ - xspace obeyspaces"
literal = ["#", "{", "}", "~", "%", ""]
simpleMacros :: [(String, Text)]
simpleMacros =
[ ("," , " ")
-- thin, non-breaking, non-stretching space
, ("\"" , "\"")
, ("`" , "`")
, ("prime" , "'")
, ("caret" , "^")
, ("copyright" , "©")
, ("textregistered" , "®")
, ("Cpp" , "C++")
, ("sum" , "∑")
, ("bot" , "⊥")
, ("perp" , "⊥")
, ("ell" , "ℓ")
, ("shr" , ">>")
, ("cv" , "cv")
, ("shl" , "<<")
, ("br" , "
")
, ("linebreak" , "
")
, ("sim" , "~")
, ("quad" , " ")
, ("qquad" , " ")
, ("indent" , " ")
, ("unun" , "__")
, ("^" , "^")
, ("ldots" , "…")
, ("vdots" , "⋮")
, ("dotsc" , "…")
, ("times" , "×")
, ("&" , "&")
, ("$" , "$")
, ("backslash" , "\\")
, ("textbackslash" , "\\")
, ("colcol" , "::")
, ("tilde" , "~")
, ("textasciitilde" , "~")
, ("hspace" , " ")
, ("space" , " ")
, ("equiv" , "≡")
, ("le" , " ≤ ")
, ("leq" , " ≤ ")
, ("ge" , " ≥ ")
, ("geq" , " ≥ ")
, ("neq" , " ≠ ")
, ("land" , " ∧ ")
, ("lor" , " ∨ ")
, ("cdot" , "·")
, ("cdots" , "⋯")
, ("to" , "→")
, ("rightarrow" , "→")
, ("mapsto" , "↦")
, ("sqrt" , "√")
, ("lfloor" , "⌊")
, ("rfloor" , "⌋")
, ("lceil" , "⌈")
, ("rceil" , "⌉")
, (";" , " ")
, ("min" , "min")
, ("max" , "max")
, ("bmod" , "mod")
, ("exp" , "exp")
, ("ln" , "ln")
, ("log" , "log")
, ("opt" , "opt")
, ("rightshift" , "rshift")
, ("textlangle" , "⟨")
, ("textrangle" , "⟩")
, ("textmu" , "μ")
, ("tablerefname" , "Table")
, ("figurerefname" , "Figure")
, ("newline" , "
")
, (">" , " ")
, ("bnfindent" , " ")
, ("\n" , "\n")
]
++ [(n, Text.pack [c]) | (n, c) <- greekAlphabet]
zwsp :: Text
zwsp = "" -- U+200B ZERO WIDTH SPACE
makeSpan, makeDiv :: [String]
makeSpan = words "center mbox mathsf emph textsc phantom term mathtt textnormal textrm descr textsl textit mathit indented"
makeDiv = words "definition cvqual emph exitnote footnote mathit paras ttfamily TableBase table tabular longtable"
indexPathString :: IndexPath -> Text
indexPathString =
replace " " "_" . -- HTML forbids space.
Text.intercalate "," .
map (indexKeyContent . indexKey)
indexShortName :: Text -> Maybe IndexKind -> Text
indexShortName "grammarindex" (Just DefinitionIndexEntry) = "nt"
indexShortName "grammarindex" Nothing = "ntref"
indexShortName "conceptindex" (Just DefinitionIndexEntry) = "concept"
indexShortName "conceptindex" Nothing = "conceptref"
indexShortName "headerindex" (Just DefinitionIndexEntry) = "header"
indexShortName "headerindex" Nothing = "headerref"
indexShortName "generalindex" (Just DefinitionIndexEntry) = "def"
indexShortName "generalindex" _ = ""
indexShortName "libraryindex" _ = "lib"
indexShortName "impldefindex" _ = ""
indexShortName "bibliography" _ = "bib"
indexShortName cat _ = error $ "indexShortName: unrecognized category: " ++ Text.unpack cat
indexPathId :: Text -> Maybe IndexKind -> IndexPath -> Text
indexPathId category kind =
(indexShortName category kind ++) .
(":" ++) .
replace " " "%20" .
replace "'" "'" .
replace "&" "&" .
indexPathString
indexPathId2 :: RenderContext -> Int -> Text -> IndexPath -> Maybe IndexKind -> Text
indexPathId2 ctx entryNr cat path kind = indexPathId cat kind path ++ indexOccurrenceSuffix ctx entryNr
indexPathId3 :: RenderContext -> LaTeX -> Text
indexPathId3 ctx indices = indexPathId2 ctx inum icat ipath ikind
where (icat, ipath, inum, ikind) : _ = indexPaths indices
indexPathHref :: Text -> Maybe IndexKind -> IndexPath -> Text
indexPathHref cat kind = (("#" ++ indexShortName cat kind ++ ":") ++) . urlChars . replace "&" "&" . indexPathString
asId :: LaTeX -> Text
asId = mconcat . map f
where
f :: LaTeXUnit -> Text
f (TeXRaw t) = replace "\n" "_" $ replace " " "_" t
f (TeXComm "tcode" _ [(_, x)]) = asId x
f (TeXComm "noncxxtcode" _ [(_, x)]) = asId x
f (TeXComm "texttt" _ [(_, x)]) = asId x
f (TeXComm "textit" _ [(_, x)]) = asId x
f (TeXComm "mathsf" _ [(_, x)]) = asId x
f (TeXComm "xspace" _ []) = "_"
f (TeXBraces x) = asId x
f (TeXMath Dollar x) = asId x
f (TeXComm "texorpdfstring" _ [_, (_, x)]) = asId x
f x = error $ "asId: unexpected: " ++ show x
instance Render Anchor where
render Anchor{..} _ =
xml "a" ([("class", aClass) | aClass /= ""] ++
[("href" , aHref ) | aHref /= ""] ++
[("id" , aId ) | aId /= ""] ++
[("title", aTitle) | aTitle /= ""] ++
[("style", aStyle) | aStyle /= ""]) aText
class Render a where render :: a -> RenderContext -> TextBuilder.Builder
concatRender :: Render a => [a] -> RenderContext -> TextBuilder.Builder
concatRender x c = mconcat $ map (\y -> render y c) x
instance Render Char where render c _ = TextBuilder.singleton c
instance (Render a, Render b) => Render (a, b) where
render (x, y) = render x ++ render y
renderCodeblock :: String -> [(ArgKind, LaTeX)] -> LaTeX -> RenderContext -> TextBuilder.Builder
renderCodeblock env args code ctx =
(case (env, args) of
("codeblocktu", [(FixArg, title)]) -> (("" ++ render title ctx ++ ":") ++)
("indexedcodeblock", [(FixArg, indices)]) ->
let
link = anchor
{ aClass = "itemDeclLink"
, aHref = "#" ++ urlChars (indexPathId3 ctx indices)
, aText = "🔗" }
in renderIndexed ctx "span" indices .
(xml "div" [("class", "marginalizedparent")] (render link ctx) ++)
_ -> id) $
xml "span" [("class", "codeblock")] (
highlightLines ctx{rawTilde=True, rawHyphens=True, rawSpace=True, inCodeBlock=True} $
concatRaws $ expandTcode (dropInitialNewline code))
where
dropInitialNewline :: LaTeX -> LaTeX
dropInitialNewline (TeXRaw (Text.uncons -> Just ('\n', rest)) : more) = TeXRaw rest : more
dropInitialNewline x = x
expandTcode :: LaTeX -> LaTeX
expandTcode [] = []
expandTcode (TeXComm "tcode" _ [(FixArg, x)] : y) = expandTcode (x ++ y)
expandTcode (x : y) = x : expandTcode y
renderOutputblock :: LaTeX -> RenderContext -> TextBuilder.Builder
renderOutputblock code ctx = xml "pre" [("class", "outputblock")] $
render code ctx{rawTilde=True, rawHyphens=True, rawSpace=True}
sameIdNamespace :: Maybe IndexKind -> Maybe IndexKind -> Bool
sameIdNamespace Nothing (Just IndexOpen) = True
sameIdNamespace (Just IndexOpen) Nothing = True
sameIdNamespace x y = x == y
isFullPage :: Page -> Bool
isFullPage FullPage = True
isFullPage _ = False
abbrIsOnPage :: Abbreviation -> Page -> Bool
abbrIsOnPage _ FullPage = True
abbrIsOnPage abbr TablesPage = "tab:" `isPrefixOf` abbr
abbrIsOnPage abbr FiguresPage = "fig:" `isPrefixOf` abbr
abbrIsOnPage abbr (FigurePage Figure{..}) = abbr == figureAbbr
abbrIsOnPage abbr (TablePage Table{..}) = abbr == tableAbbr
abbrIsOnPage abbr (SectionPage sec)
| "fig:" `isPrefixOf` abbr = abbr `elem` (figureAbbr . snd . figures sec)
| "eq:" `isPrefixOf` abbr = abbr `elem` (formulaAbbr . snd . formulas sec)
| "tab:" `isPrefixOf` abbr = abbr `elem` (tableAbbr . snd . tables sec)
| otherwise = abbr `elem` (abbreviation . sections sec)
abbrIsOnPage _ _ = False
pageIndexEntries :: RenderContext -> IntMap.IntMap IndexEntry
pageIndexEntries c
| SectionPage s <- page c = secIndexEntries s
| otherwise = indexEntryMap (draft c)
indexOccurrenceSuffix :: RenderContext -> Int -> Text
-- Returns the _ that distinguishes expr#def:object_expression from
-- expr#def:object_expression_ ([expr] has two definitions of 'object expression',
-- one for E1.E2 and one for E1.*E2.)
indexOccurrenceSuffix c indexNum = underscores
where
Just theEntry = IntMap.lookup indexNum (pageIndexEntries c)
ies
| SectionPage s <- page c = secIndexEntriesByPath s
| otherwise = indexEntriesByPath (draft c)
underscores = Text.pack
[ '_' | (i, e) <- fromJust (Map.lookup (indexPath theEntry) ies)
, indexCategory e == indexCategory theEntry
, sameIdNamespace (indexEntryKind e) (indexEntryKind theEntry)
, i < indexNum ]
instance Render LaTeX where
render (TeXComm "textbackslash" _ [] : y)
| (TeXRaw s : rest) <- y = \sec -> "\\" ++ render (TeXRaw $ if rawSpace sec then s else unspace s) sec ++ render rest sec
where
unspace s
| Just (c, cc) <- Text.uncons s, isSpace c = cc
| otherwise = s
render (TeXComm "itshape" _ [] : x) = ("" ++) . (++ "") . render x
render (x : y) = render x ++ render y
render [] = return ""
keywords :: [Text]
keywords = map Text.pack $ words $
"char8_t char16_t char32_t namespace struct void operator friend template typedef long short class double public extern " ++
"using char new union unsigned sizeof alignas typename virtual this return const_cast delete noexcept static_cast " ++
"reinterpret_cast mutable bool private protected inline constexpr consteval final volatile default explicit enum export asm " ++
"typeid dynamic_cast throw if else for do while goto auto concept requires decltype try catch static_assert wchar_t " ++
"case switch alignof break continue signed audit axiom override const register thread_local int float static module import " ++
"co_return co_await co_yield constinit contract_assert"
-- todo: read the real keyword table instead
highlightLines :: RenderContext -> LaTeX -> TextBuilder.Builder
highlightLines ctx x
| (spaces, x') <- texSpan (== ' ') x, spaces /= "" = TextBuilder.fromText spaces ++ highlightLines ctx x'
| Just (directive, x') <- parseCppDirective x = spanTag "preprocessordirective" (render directive ctx) ++ highlight ctx x'
| TeXComm (Text.pack -> c) _ [(FixArg, y)] : more <- x, c `elem` ["terminal"] = spanTag c (highlightLines ctx y) ++ highlight ctx more
| i@(TeXComm cmd _ _) : more <- x, cmd `elem` ["index", "obeyspaces"] = render i ctx ++ highlightLines ctx more
| otherwise = highlight ctx x
highlightUnit :: RenderContext -> LaTeXUnit -> TextBuilder.Builder
highlightUnit ctx x = case x of
TeXComm "rlap" _ [(FixArg, text)] ->
spanTag "rlap" (highlight ctx text)
TeXComm "indexedspan" _ [(FixArg, text), (FixArg, indices)] ->
renderIndexed ctx "span" indices (highlight ctx text)
TeXComm "terminal" _ [(FixArg, y)] ->
spanTag "terminal" (highlight ctx y)
TeXComm c _ []
| c `elem` ["%", "&", "caret", "~"] -> spanTag "operator" (render x ctx)
| c == "#" -> spanTag "preprocessordirective" (render x ctx)
| c `elem` ["{", "}"] -> spanTag "curlybracket" (render x ctx)
TeXBraces y -> highlight ctx y
_ -> render x ctx
highlight :: RenderContext -> LaTeX -> TextBuilder.Builder
highlight ctx (TeXRaw kwd : TeXComm "-" "" [] : x)
| kwd `elem` keywords = TextBuilder.fromText kwd ++ highlight ctx x
highlight ctx (TeXRaw kwd : rest@(TeXComm "textit" _ [(FixArg, (TeXRaw (Text.uncons -> Just (isAlphaNum -> True, _)) : _))] : _))
| kwd `elem` keywords = TextBuilder.fromText kwd ++ highlight ctx rest
highlight ctx x
| Just x' <- texStripPrefix "\n" x = "\n" ++ highlightLines ctx x'
| (TeXRaw "" : t) <- x = highlight ctx t
| Just (lit, x') <- parseLiteral x = spanTag "literal" (render lit ctx) ++ highlight ctx x'
| Just (comment, x') <- parseComment x = spanTag "comment" (render comment ctx{inComment=True, rawTilde=False}) ++ highlightLines ctx x'
| Just x' <- texStripPrefix "" x = spanTag "operator""<" ++ "new" ++ spanTag "operator" ">" ++ highlight ctx x'
-- keywords
| (a, x') <- texSpan p x, a /= "" = (case () of
_ | a `elem` keywords -> spanTag "keyword"
_ | a `elem` ["defined", "__has_include", "__has_embed", "__has_cpp_attribute", "_Pragma"] -> spanTag "preprocessordirective"
_ | a `elem` ["nullptr", "true", "false"] -> spanTag "literal"
_ | otherwise -> id) (render (TeXRaw a) ctx) ++ highlight ctx x'
where p c = isAlphaNum c || c == '_'
highlight ctx (TeXRaw x : more)
| Text.head x `elem` ("'\"" :: String) = render (TeXRaw $ Text.take 1 x) ctx ++ highlight ctx (TeXRaw (Text.tail x) : more)
| Text.head x `elem` ("()"::String) = spanTag "parenthesis" (render (TeXRaw $ Text.take 1 x) ctx) ++ highlight ctx (TeXRaw (Text.tail x) : more)
| Text.head x `elem` ("{}"::String) = spanTag "curlybracket" (render (TeXRaw $ Text.take 1 x) ctx) ++ highlight ctx (TeXRaw (Text.tail x) : more)
| Text.head x `elem` ("[]"::String) = spanTag "squarebracket" (render (TeXRaw $ Text.take 1 x) ctx) ++ highlight ctx (TeXRaw (Text.tail x) : more)
| Text.head x `elem` ("<>"::String) = spanTag "anglebracket" (render (TeXRaw $ Text.take 1 x) ctx) ++ highlight ctx (TeXRaw (Text.tail x) : more)
| Text.head x == '#' = spanTag "preprocessordirective" "#" ++ highlight ctx (TeXRaw (Text.tail x) : more)
| Text.take 2 x == "::"
= spanTag "operator" (render (TeXRaw "::") ctx) ++ highlight ctx (TeXRaw (Text.drop 2 x) : more)
| Text.head x `elem` ("*&^.-+/!=|:?%~#"::String)
= spanTag "operator" (render (TeXRaw (Text.take 1 x)) ctx) ++ highlight ctx (TeXRaw (Text.tail x) : more)
| (a, x') <- Text.span (\c -> not (isAlphaNum c || c `elem` ("#%_(){}[]<>.*:?'\"+=-/|&!^~\n" :: String))) x, a /= ""
= render (TeXRaw a) ctx ++ highlight ctx (TeXRaw x' : more)
| otherwise = error ("shit: " ++ show x)
highlight ctx (x : more) = highlightUnit ctx x ++ highlight ctx more
highlight _ [] = ""
indexPaths :: LaTeX -> [(Text, IndexPath, Int, Maybe IndexKind)]
indexPaths indices =
[ (cat, path, entryNr, kind)
| [ (FixArg, [TeXRaw (Text.unpack -> read -> entryNr)])
, (OptArg, [TeXRaw cat])
, (FixArg, (parseIndex -> (path, kind))) ] <- lookForCommand "index" indices]
renderIndexed :: RenderContext -> Text -> LaTeX -> TextBuilder.Builder -> TextBuilder.Builder
renderIndexed ctx thing indices body = foldl f body (indexPaths indices)
where f t (cat, path, entryNr, kind) = xml thing [("id", indexPathId2 ctx entryNr cat path kind)] t
commasAnd :: [TextBuilder.Builder] -> TextBuilder.Builder
commasAnd [] = undefined
commasAnd [x] = x
commasAnd [x, y] = x ++ " and " ++ y
commasAnd [x, y, z] = x ++ ", " ++ y ++ ", and " ++ z
commasAnd (x : y) = x ++ ", " ++ commasAnd y
abbrTitle :: Text -> Bool -> RenderContext -> Text
abbrTitle "bibliography" _ _ = "Bibliography"
abbrTitle abbr includeAbbr ctx
| "tab:" `isPrefixOf` abbr
, Just Table{..} <- tableByAbbr (draft ctx) abbr =
"Table " ++ Text.pack (show tableNumber) ++ ": " ++
LazyText.toStrict (TextBuilder.toLazyText $ render tableCaption ctx{noTags=True})
| Just sec@Section{..} <- sectionByAbbr (draft ctx) abbr =
LazyText.toStrict $ TextBuilder.toLazyText $
secnumText sec ++ " " ++
render sectionName ctx{noTags=True} ++
TextBuilder.fromText (if includeAbbr then " [" ++ abbr ++ "]" else "")
| otherwise = ""
renderBreak :: RenderContext -> TextBuilder.Builder
renderBreak ctx = if noTags ctx then "\n" else "
"
renderIndexLink :: String -> [(ArgKind, [LaTeXUnit])] -> RenderContext -> TextBuilder.Builder
renderIndexLink cmd [(FixArg, txt), (FixArg, [TeXRaw cat]), (FixArg, rawIndexPath), (FixArg, abbr_arg)] ctx
| not (noTags ctx)
, Just abbr <- mabbr = render anchor
{ aText = render txt ctx{inLink=True}
, aHref = (if abbrIsOnPage abbr (page ctx) then "" else linkToSectionHref SectionToSection abbr)
++ indexPathHref cat kind p
, aTitle = abbrTitle abbr True ctx
, aClass = if cmd == "hiddenindexlink" then "hidden_link" else ""
} ctx
| otherwise = render txt ctx
where
(p, kind) = parseIndex rawIndexPath
resolved :: Maybe Text
resolved = case Map.lookup p $ indexEntriesByPath (draft ctx) of
Just entries
| (hd:_) <- [ abbreviation
| (_, IndexEntry{indexEntrySection=abbreviation, indexEntryKind}) <- entries
, indexEntryKind == kind
, not ("gram." `isPrefixOf` abbreviation) ] -> Just hd
_ -> Nothing
traceIfBad
| resolved == Nothing, cat /= "grammarindex", cat /= "bibliography" =
trace $ "\nbad index link: " ++ show (cat, rawIndexPath)
++ "\nlookup result: " ++ show (Map.lookup p $ indexEntriesByPath (draft ctx))
| otherwise = id
mabbr = traceIfBad $ case abbr_arg of
[] -> resolved
[TeXRaw x] -> Just x
y -> error $ "bad indexlink arg: " ++ show y
renderIndexLink _ _ _ = error "bad indexlink"
instance Render LaTeXUnit where
render (TeXRaw x ) = \RenderContext{..} -> TextBuilder.fromText
$ (if rawHyphens then id else replace "--" "–" . replace "---" "—")
$ (if not inCodeBlock then replace "''" "”" else id)
$ (if rawTilde then id else replace "~" " ")
$ (if not insertBreaks then id else
replace "::" (zwsp ++ "::" ++ zwsp) .
replace "\1" "__" .
replace "_" (if noTags then "_" else "_") .
replace "__" "\1")
$ (if replXmlChars then replaceXmlChars else id)
$ x
render (TeXComm "br" _ _ ) = renderBreak
render TeXLineBreak = renderBreak
render (TeXComm "break" _ [] ) = renderBreak
render (TeXBraces t ) = render t
render m@(TeXMath _ _ ) = renderMath [m]
render (TeXComm "commentellip" _ []) = const $ spanTag "comment" "/* ... */"
render (TeXComm "ensuremath" _ [(FixArg, x)]) = renderMath x
render (TeXComm "hyperref" _ [_, (FixArg, x)]) = render x
render (TeXComm "label" _ [(FixArg, [TeXRaw x])]) = render anchor{aId = x, aClass = "index"}
render (TeXComm "ref*" x y) = render (TeXComm "ref" x y)
render (TeXComm "ref" _ [(FixArg, concatRaws -> [TeXRaw abbr])]) = \ctx@RenderContext{..} ->
let
linkText :: TextBuilder.Builder
linkText
| "tab:" `isPrefixOf` abbr
, Just Table{..} <- tableByAbbr draft abbr = TextBuilder.fromString $ show tableNumber
| "fig:" `isPrefixOf` abbr
, Figure{..} <- figureByAbbr draft abbr = TextBuilder.fromString $ show figureNumber
| "eq:" `isPrefixOf` abbr
, f@Formula{..} <- formulaByAbbr draft abbr = TextBuilder.fromText $ fullFormulaNumber f
| otherwise = squareAbbr (not noTags) abbr
renderLabelRef sec =
simpleRender2 anchor{
aHref = abbrHref (abbreviation sec) ctx ++ "#" ++ abbr,
aText = squareAbbr (not noTags) (abbreviation sec),
aTitle = abbrTitle (abbreviation sec) False ctx }
renderSectionRef =
simpleRender2 anchor{
aHref = abbrHref abbr ctx,
aText = linkText,
aTitle = abbrTitle abbr False ctx }
in if noTags then linkText else
case Map.lookup abbr (labels draft) of
Just sec -> renderLabelRef sec
Nothing
| SectionPage pageSec <- page, abbreviation pageSec == abbr -> linkText
| otherwise -> renderSectionRef
render (TeXComm "iref" _ [(FixArg, [TeXRaw abbrs])]) = \ctx ->
let renderAbbr abbr = render (TeXComm "ref" "" [(FixArg, [TeXRaw abbr])]) ctx
in " (" ++ mconcat (intersperse ", " $ map (renderAbbr . Text.strip) $ Text.splitOn "," abbrs) ++ ")"
render (TeXComm "nopnumdiffref" _ [(FixArg, [TeXRaw (Text.splitOn "," -> abbrs)])]) = \ctx ->
let f abbr = simpleRender2 anchor{aHref = abbrHref abbr ctx, aText = squareAbbr True abbr}
in "Affected " ++ (if length abbrs == 1 then "subclause" else "subclauses") ++ ": "
++ commasAnd (map f abbrs)
render (TeXComm "weblink" _ [(FixArg, text), (FixArg, href)])
= render anchor
{ aText = simpleRender2 text
, aHref = simpleRender href}
render (TeXComm "url" _ [(FixArg, u)])
= render anchor
{ aText = simpleRender2 u
, aHref = simpleRender u }
render (TeXComm "link" _ [(FixArg, txt), (FixArg, [TeXRaw abbr])])
= \ctx -> if noTags ctx then render txt ctx else render anchor{
aHref = abbrHref abbr ctx,
aText = render txt ctx{inLink=True},
aTitle = abbrTitle abbr True ctx} ctx
render (TeXComm c _ l) | c `elem` ["indexlink", "hiddenindexlink"] = renderIndexLink c l
render (TeXComm "color" _ _) = const ""
render (TeXComm "textcolor" _ [_, (FixArg, x)]) = render x
render (TeXComm "textsmaller" _ [_, (FixArg, x)]) = render x
render (TeXComm "terminal" _ [(FixArg, x)]) = spanTag "terminal" . flip highlightLines x
render (TeXComm "texttt" _ [(FixArg, x)]) = \ctx ->
(if noTags ctx then id else spanTag "texttt") $ render x ctx{rawHyphens = True, insertBreaks = True}
render (TeXComm "literaltcode" _ [(FixArg, x)]) = spanTag "literal" . spanTag "texttt" . render x
render (TeXComm cmd _ [(FixArg, x)])
| cmd `elem` ["tcode"] = \ctx ->
if noTags ctx then render x ctx{rawHyphens=True, insertBreaks=True}
else spanTag (if inCodeBlock ctx then "tcode_in_codeblock" else "texttt") $
if not (inComment ctx) && not (inLink ctx) && not (inSectionTitle ctx)
then highlightLines ctx{rawHyphens=True, insertBreaks=True} x
else render x ctx{rawHyphens=True, insertBreaks=True}
render (TeXComm "noncxxtcode" _ [(FixArg, x)]) = \ctx ->
spanTag (if inCodeBlock ctx then "tcode_in_codeblock" else "texttt") $
render x ctx{rawHyphens=True, insertBreaks=True}
render (TeXComm "textbf" _ [(FixArg, x)]) = ("" ++) . (++ "") . render x
render (TeXComm "index" _
[ (FixArg, [TeXRaw (Text.unpack -> read -> entryNr)])
, (OptArg, [TeXRaw category])
, (FixArg, (parseIndex -> (p, kind)))
])
= \ctx -> if noTags ctx then "" else case kind of
Just IndexClose -> ""
Just (See _ _) -> ""
_ -> render anchor
{ aId = indexPathId2 ctx entryNr category p kind
, aClass = "index"} ctx
render (TeXComm "indexedspan" _ [(FixArg, text), (FixArg, indices)]) =
\ctx -> (if noTags ctx then id else renderIndexed ctx "span" indices) $ render text ctx
render (TeXEnv "indexeditemdecl" [(FixArg, indices)] t) = \ctx ->
let
link = anchor
{ aClass = "itemDeclLink"
, aHref = "#" ++ urlChars (indexPathId3 ctx indices)
, aText = "🔗" }
in
renderIndexed ctx "div" indices $
xml "div" [("class", "itemdecl")] $
xml "div" [("class", "marginalizedparent")] (render link ctx) ++
xml "code" [("class", "itemdeclcode")] (TextBuilder.fromText $ Text.dropWhile (== '\n') $ LazyText.toStrict $ TextBuilder.toLazyText $ highlightLines ctx{rawTilde=True, rawHyphens=True} t)
render (TeXComm "discretionary" _ _) = const (TextBuilder.fromText zwsp)
render (TeXComm "ifthenelse" _ [_, _, (FixArg, x)]) = render x
render (TeXComm "multicolumn" _ [(FixArg, [TeXRaw n]), _, (FixArg, content)]) = xml "td" [("colspan", n)] . render content
render (TeXComm "leftshift" _ [(FixArg, content)]) =
(spanTag "mathsf" "lshift" ++) . xml "sub" [("class", "math")] . render content
render (TeXComm "verb" _ [(FixArg, a)]) = \c -> xml "code" [] $ render a c{rawTilde=True, rawHyphens=True}
render (TeXComm "footnoteref" _ [(FixArg, [TeXRaw n])]) = \ctx -> flip render ctx $ anchor
{ aClass = "footnoteref"
, aText = TextBuilder.fromText n
, aId = "footnoteref-" ++ n
, aTitle = (!! 3) $ iterate (Text.replace " " " ")
$ Text.replace "\n" " "
$ Text.replace "'" "'"
$ LazyText.toStrict $ TextBuilder.toLazyText
$ mconcat $ map (flip render ctx{noTags = True})
$ footnoteContent $ snd
$ footnotes (draft ctx) !! ((read (Text.unpack n) :: Int) - 1)
, aHref =
(if isFullPage (page ctx) || isSectionPage (page ctx) then "" else "SectionToSection/" ++ paraUrl ctx)
++ "#footnote-" ++ n }
render (TeXComm "raisebox" _ args)
| (FixArg, concatRaws -> [TeXRaw d]) <- head args
, (FixArg, content) <- Prelude.last args =
let neg s
| Text.head s == '-' = Text.tail s
| otherwise = "-" ++ s
in xml "span" [("style", "position: relative; top: " ++ neg d)] . render content
render (TeXComm "parbox" _ [_, (FixArg, x)]) = render x
render (TeXComm "term" _ [(FixArg, x)]) =
\sec ->
let
i = "def:" ++ asId x
-- It's tempting to use 'term:' instead of 'def:' here, but if we do that,
-- URLs break when upstream promotes a \term to a \defn.
in render anchor
{ aText = "" ++ render x sec ++ ""
, aId = i
, aHref = "#" ++ urlChars i
, aClass = "hidden_link" } sec
render (TeXComm "texorpdfstring" _ [_, (FixArg, x)]) = render x
render (TeXComm " " _ []) = return " "
render (TeXComm "\n" _ []) = return "\n"
render (TeXComm "textit" _ [(FixArg, x)]) = \c -> (if noTags c then id else xml "i" []) $ render x c{rawTilde = False}
render (TeXComm "c" _ [(FixArg, [TeXRaw "t"])]) = return "ţ"
render (TeXComm s _ [])
| s == "caret" = return "^"
| s `elem` literal = return $ TextBuilder.fromString s
| Just x <-
lookup s simpleMacros = return $ TextBuilder.fromText x
| s `elem` kill = return ""
| otherwise = return $ spanTag (Text.pack s) ""
render (TeXComm "class" _ [(FixArg, [TeXRaw cls]), (FixArg, [TeXComm "href" _ [(FixArg, [TeXRaw href]), (FixArg, text)]])])
= \ctx -> render anchor{aHref=href, aText=render text ctx, aClass=cls} ctx
render (TeXComm "class" _ [(FixArg, [TeXRaw cls]), (FixArg, x)])
= \ctx -> spanTag cls $ render x ctx
render (TeXComm "href" _ [(FixArg, [TeXRaw href]), (FixArg, text)])
= \ctx -> render anchor{aHref=href, aText=render text ctx} ctx
render (TeXComm "ucode" _ [(FixArg, code)]) = spanTag "ucode" . render (TeXRaw "U+" : code)
render (TeXComm x _ s)
| x `elem` kill = return ""
| null s, Just y <-
lookup x simpleMacros = return $ TextBuilder.fromText y
| [(FixArg, z)] <- s, Just y <-
lookup x simpleMacros = (TextBuilder.fromText y ++) . render z
| otherwise = \ctx -> (if noTags ctx then id else spanTag (Text.pack x)) $ render (s >>= snd) ctx
render (TeXEnv "itemdecl" [(FixArg, [TeXRaw num])] t) = \c ->
let
i = case [(icat, ipath) | (icat, ipath, _inum, Just DefinitionIndexEntry) <- indexPaths t] of
[(icat, ipath)] -> indexPathId icat (Just DefinitionIndexEntry) ipath
_ -> mconcat (idPrefixes c) ++ "itemdecl:" ++ num
link = anchor{aClass="itemDeclLink", aHref="#" ++ urlChars i, aText="🔗"}
in
xml "div" [("class", "itemdecl"), ("id", i)] $
xml "div" [("class", "marginalizedparent")] (render link c) ++
xml "code" [("class", "itemdeclcode")] (TextBuilder.fromText $ Text.dropWhile (== '\n') $ LazyText.toStrict $ TextBuilder.toLazyText $ highlightLines c{rawTilde=True, rawHyphens=True} t)
render env@(TeXEnv e args t)
| e `elem` makeSpan = \ctx -> (if noTags ctx then id else spanTag (Text.pack e)) (render t ctx)
| e `elem` makeDiv = xml "div" [("class", Text.pack e)] . render t
| isMath env && hasComplexMath True [env] = renderComplexMath [env]
| isCodeblock env = renderCodeblock e args t
| e == "minipage", [e2@(TeXEnv _ _ cb)] <- trim t, isCodeblock e2 =
xml "div" [("class", "minipage")] . renderCodeblock "codeblock" [] cb
| e == "outputblock" = renderOutputblock t
| e == "itemdescr" = render t
| e == "thebibliography" = render t
| otherwise = error $ "render: unexpected " ++ show env
instance Render Int where render = return . TextBuilder.fromString . show
instance Render IndexComponent where
render IndexComponent{..} = render indexKey
instance Render IndexEntry where
render IndexEntry{indexEntryKind=Just (See also x), ..} = \ctx ->
"" ++ (if also then "see also" else "see") ++ " " ++
render (anchor
{ aHref = "#:" ++
(urlChars $
replace " " "_" $
replace ", " "," $
indexKeyContent x)
, aText = render x ctx}) ctx
render IndexEntry{indexEntryKind=Just IndexClose} = return ""
render IndexEntry{..} =
return $ simpleRender2 anchor
{ aHref = "SectionToSection/" ++ urlChars indexEntrySection
++ indexPathHref indexCategory indexEntryKind indexPath
, aText = (if indexEntryKind == Just DefinitionIndexEntry then xml "b" [] else id) $ squareAbbr True indexEntrySection }
indexDisplayOrder :: IndexComponent -> (([(Int, Int)], Int), ([(Int, Int)], Int))
indexDisplayOrder y = (f (indexSortKey y), f (indexKey y))
where
g :: Char -> (Int, Int)
g c
| isDigit c = (1, ord c)
| isAlpha c = (2, ord (toLower c))
| otherwise = (0, ord c)
he :: String -> ([(Int, Int)], Int)
he x = (map g x, if isUpper (head x) then 0 else 1)
f = he . Text.unpack . indexKeyContent
instance Render [(IndexComponent, IndexNode)] where
render tree ctx = go [] tree
where
IndexPage cat = page ctx
go :: IndexPath -> [(IndexComponent, IndexNode)] -> TextBuilder.Builder
go up x = mconcat $ f up . (sortOn (indexDisplayOrder . fst) x)
f :: IndexPath -> (IndexComponent, IndexNode) -> TextBuilder.Builder
f up (comp, IndexNode{..}) =
let
up' = up ++ [comp]
in
xml "div" [("id", indexPathId cat Nothing up')] $
xml "div" [("class", "indexitems")] $
TextBuilder.fromText (
Text.intercalate ", " (nub $ filter (/= "") $ map (LazyText.toStrict . TextBuilder.toLazyText) $ render comp ctx : flip render ctx . indexEntries)) ++
go up' (Map.toList indexSubnodes)
data IndexHeading = Symbols | Numbers | Letter Char
deriving (Eq, Ord)
instance Show IndexHeading where
show Symbols = "Symbols"
show Numbers = "Numbers"
show (Letter c) = [c]
indexHeading :: IndexComponent -> IndexHeading
indexHeading (indexSortKey -> indexKeyContent -> Text.head -> c)
| isDigit c = Numbers
| isAlpha c = Letter (toUpper c)
| otherwise = Symbols
indexSortKey :: IndexComponent -> LaTeX
indexSortKey IndexComponent{..}
| distinctIndexSortKey /= [] = distinctIndexSortKey
| otherwise = indexKey
renderIndex :: RenderContext -> IndexTree -> TextBuilder.Builder
renderIndex ctx tree
| name `elem` ["generalindex", "libraryindex"] = mconcat $ ["
"] ++ linklines ++ ["
"] ++ map sub p
| otherwise = render (Map.toList tree) ctx
where
IndexPage name = page ctx
p = partitionBy (indexHeading . fst) $ Map.toList tree
sub (n, ii) = h 2 (render anchor{aText=TextBuilder.fromText $ Text.pack (show n), aId=Text.pack (show n)} ctx) ++ render ii ctx
(symnum, rest) = splitAt 2 p
linklines = map (h 2 . mconcat . intersperse " " . map (li . fst)) [symnum, rest]
li n = render anchor{aText = TextBuilder.fromText $ Text.pack (show n), aHref = "#" ++ Text.pack (show n)} ctx
renderTab :: Bool -> Table -> Text -> Bool -> Bool -> RenderContext -> TextBuilder.Builder
renderTab stripTab Table{..} href boldCaption linkifyTableNum ctx =
xml "div" [("class", "numberedTable"), ("id", id_)] $ -- todo: multiple abbrs?
(if boldCaption then "" else "") ++
"Table " ++ tableNumF (render tableNumber ctx) ++ " — " ++
render tableCaption ctx ++
" " ++
render anchor{aText="[" ++ TextBuilder.fromText tableAbbr ++ "]", aHref=href} ctx ++
(if boldCaption then "" else "") ++
"
" ++
renderTable columnSpec tableBody ctx
where
tableNumF = if linkifyTableNum then linkify anchor{aHref = "#" ++ id_} ctx else id
id_ = (if stripTab then replace "tab:" "" else id) tableAbbr
linkify :: Anchor -> RenderContext -> TextBuilder.Builder -> TextBuilder.Builder
linkify a ctx txt = render a{aText=txt} ctx
renderFig :: Bool -> Figure -> Text -> Bool -> Bool -> RenderContext -> TextBuilder.Builder
renderFig stripFig Figure{..} href boldCaption linkifyFigureNum ctx =
xml "div" [("class", "figure"), ("id", id_)] $
TextBuilder.fromText figureSvg ++ "
" ++
(if boldCaption then "" else "") ++
"Figure " ++ figureNumF (render figureNumber ctx) ++ " — " ++
render figureName ctx ++ " " ++
render anchor{aText=squareAbbr False figureAbbr, aHref=href} ctx ++
(if boldCaption then "" else "")
where
figureNumF = if linkifyFigureNum then linkify anchor{aHref="#" ++ id_} ctx else id
id_ = (if stripFig then replace "fig:" "" else id) figureAbbr
data RenderItem = RenderItem { listOrdered :: Bool, item :: Item }
spacedJoin :: TextBuilder.Builder -> TextBuilder.Builder -> TextBuilder.Builder
spacedJoin x y
| TextBuilder.toLazyText x == "" = y
| TextBuilder.toLazyText y == "" = x
| otherwise = x ++ " " ++ y
instance Render RenderItem where
render RenderItem{item=Item Nothing mlabel elems paras} ctx
= xml "li" attrs $ render elems ctx ++ renderLatexParas paras ctx
where
attrs
| Just [TeXRaw l] <- mlabel = [("id", l)]
| otherwise = []
render RenderItem{item=Item (Just nn) mlabel elems paras, ..} ctx
| listOrdered =
xml "tr" [("id", thisId)] $
(xml "td" [] (case mlabel of
Nothing -> render link ctx'
Just label -> render anchor{aHref = linkHref, aText=simpleRender2 label} ctx' ++ " ")) ++
(xml "td" [] content)
| otherwise =
xml "li" [("id", thisId)] $ case mlabel of
Nothing -> xml "div" [("class", "marginalizedparent"), ("style", "left:" ++ left)] (render link ctx') ++ content
Just label ->
render anchor{aHref = linkHref, aText=simpleRender2 label} ctx'
++ " " ++ content
where
content = spacedJoin (render elems ctx') (renderLatexParas paras ctx')
left
| listOrdered = "-4.5em"
| otherwise = simpleRender (-marginalizedParentLeft - ulPaddingLeft * (length nn - 1) - extraIndentation ctx) ++ "mm"
ulPaddingLeft = 9
marginalizedParentLeft = 18
thisId = mconcat (idPrefixes ctx) ++ Text.pack (Prelude.last nn)
ctx' = ctx{ idPrefixes = idPrefixes ctx ++ [Text.pack (Prelude.last nn) ++ "."] }
dottedNumber = Text.intercalate "." (Text.pack . nn)
linkText
| listOrdered =
let
s = Prelude.last nn
punct
| isAlpha (head s) = ")"
| otherwise = "."
in
Text.pack $ s ++ punct
| otherwise = "(" ++ dottedNumber ++ ")"
linkClass
| listOrdered = "enumerated_item_num"
| otherwise = "marginalized"
linkHref = "#" ++ thisId
link = anchor{aClass=linkClass, aHref=linkHref, aText=TextBuilder.fromText linkText}
paraUrl :: RenderContext -> Text
paraUrl RenderContext{..} = urlChars $ abbreviation $ case nearestEnclosing of
Left p -> paraSection p
Right s -> s
prependSentence :: Sentence -> TeXPara -> TeXPara
prependSentence s (TeXPara ss) = TeXPara (s : ss)
instance Render Footnote where
render (Footnote n content) ctx =
xml "div" [("class", "footnote"), ("id", i)] $
renderParas (mapHead (prependSentence footnoteNum) content)
where
footnoteNum = Sentence Nothing [HtmlElement (LazyText.toStrict $ TextBuilder.toLazyText $ render (link, backlink) ctx)]
ctx' = ctx{idPrefixes = [i ++ "."]}
backlink = anchor{aText = linkText, aHref = "#footnoteref-" ++ num, aClass = "footnoteBacklink"}
renderParas [] = ""
renderParas (p:pp) = xml "div" [("class", "texpara")] (render p ctx') ++ renderParas pp
num = Text.pack $ show n
i = "footnote-" ++ num
footnoteIsOnPage = isFullPage (page ctx) || isSectionPage (page ctx)
linkText = TextBuilder.fromText $ num ++ ")"
link = anchor
{ aText = linkText
, aClass = "footnotenum"
, aHref =
(if footnoteIsOnPage then "" else "SectionToSection/" ++ paraUrl ctx)
++ "#" ++ i }
noWrapSpace :: TextBuilder.Builder
noWrapSpace = " "
instance Render Note where
render Note{..} ctx = xml "div" [("id", i), ("class", "note")] (renderParas True noteContent)
where
prefix = "[" ++ TextBuilder.fromText noteLabel ++ " " ++ render link ctx ++ ": "
suffix = " —" ++ noWrapSpace ++ "end note]"
renderParas _ [] = ""
renderParas isFirst (p:pp) = xml "div" [("class", "texpara")] ((if isFirst then prefix else "") ++ render p ctx ++ (if null pp then suffix else "")) ++ renderParas False pp
i = mconcat (dropWhileEnd (isDigit . Text.head) (idPrefixes ctx)) ++ "note-" ++ noteNum
noteNum = Text.pack $ show noteNumber
link = anchor{aHref = "#" ++ i, aText = TextBuilder.fromText noteNum }
instance Render Example where
render Example{..} ctx
| noTags ctx =
"[Example: "
++ renderLatexParas exampleContent ctx
++ " — end example] "
| otherwise = xml "div" [("id", i), ("class", "example")] (renderParas True exampleContent)
where
prefix = "[Example " ++ render link ctx ++ ": "
suffix = " —" ++ noWrapSpace ++ "end example]"
renderParas _ [] = ""
renderParas isFirst (p:pp) = xml "div" [("class", "texpara")] ((if isFirst then prefix else "") ++ render p ctx ++ (if null pp then suffix else "")) ++ renderParas False pp
i = mconcat (dropWhileEnd (isDigit . Text.head) (idPrefixes ctx)) ++ "example-" ++ exNum
exNum = Text.pack $ show exampleNumber
link = anchor{aHref = "#" ++ i, aText = TextBuilder.fromText exNum }
instance Render Formula where
render f@Formula{..} ctx =
xml "div" [("class", "formula"), ("id", formulaAbbr)] $
doRenderComplexMath [TeXMath Square ([tag] ++ formulaContent)] ctx
where tag = TeXComm "tag" "" [(FixArg, [TeXRaw (fullFormulaNumber f)])]
fullFormulaNumber :: Formula -> Text
fullFormulaNumber Formula{..} = Text.pack $ show chapterNum ++ "." ++ show formulaNumber
where chapterNum = sectionNumber $ chapterOfSection formulaSection
nontermDef :: LaTeX -> Maybe Text
nontermDef t
| [n] <- [n | ("grammarindex", [IndexComponent{distinctIndexSortKey=[TeXRaw n]}], _inum, Just DefinitionIndexEntry) <- indexPaths t] = Just n
| otherwise = Nothing
instance Render Element where
render (HtmlElement html) = const $ TextBuilder.fromText html
render (LatexElement x) = render x
render (Codeblock x) = render x
render (Itemdescr x) = xml "div" [("class", "itemdescr")] . renderLatexParas x
render (NoteElement x) = render x
render (ExampleElement x) = render x
render (Bnf e t) = xml "div" ([("class", Text.pack e)] ++ idattr) . render t
where
idattr
| Just nt <- nontermDef t = [("id", "nt:" ++ nt)]
| otherwise = []
render (TableElement t) = \ctx ->
renderTab False t ("./SectionToSection/" ++ tableAbbr t) False True ctx{idPrefixes=[tableAbbr t++"-"]}
render (FigureElement f) = renderFig False f ("./SectionToSection/" ++ figureAbbr f) False True
render (FormulaElement f) = render f
render (Tabbing t) =
xml "pre" [] . TextBuilder.fromText . htmlTabs . LazyText.toStrict . TextBuilder.toLazyText . render (preprocessPre t) -- todo: this is horrible
render Enumerated{..} = xml t [("class", Text.pack enumCmd)] .
concatRender (RenderItem (enumCmd == "enumerate") . enumItems)
where
t = case enumCmd of
"enumerate" -> "table"
"itemize" -> "ul"
"description" -> "ul"
"thebibliography" -> "ul"
_ -> undefined
class HasComplexMath a where
hasComplexMath :: Bool -> a -> Bool
instance HasComplexMath LaTeXUnit where
hasComplexMath mathMode (TeXRaw x) = mathMode && Text.any (`elem` ("+-*/^_=' " :: String)) (Text.strip x)
hasComplexMath m (TeXComm c _ args)
| c `elem` words "frac sum binom int sqrt lfloor rfloor lceil rceil log mathscr mapsto cdot bmod" = True
| c `elem` words "tcode" = hasComplexMath False (map snd args)
| otherwise = hasComplexMath m (map snd args)
hasComplexMath _ (TeXMath _ x) = hasComplexMath True x
hasComplexMath m (TeXBraces x) = hasComplexMath m x
hasComplexMath m (TeXEnv e _ args)
| e `elem` ["array", "eqnarray"] = True
| otherwise = hasComplexMath m args
hasComplexMath _ TeXLineBreak = False
instance HasComplexMath a => HasComplexMath [a] where
hasComplexMath m = any (hasComplexMath m)
data Page
= SectionPage Section
| TablePage Table
| FigurePage Figure
| FullPage
| IndexPage Text {- category -}
| XrefDeltaPage
| FootnotesPage
| TablesPage
| FiguresPage
| TocPage
| ExpandedTocPage
isSectionPage :: Page -> Bool
isSectionPage (SectionPage _) = True
isSectionPage _ = False
data RenderContext = RenderContext
{ page :: Page
, draft :: Draft
, nearestEnclosing :: Either Paragraph Section
, rawHyphens :: Bool -- in real code envs /and/ in \texttt
, rawTilde :: Bool -- in real code envs but not in \texttt
, rawSpace :: Bool
, insertBreaks :: Bool
, inLink :: Bool -- so as not to linkify grammarterms that appear as part of a defined/linkified term/phrase
, inCodeBlock :: Bool -- in codeblocks, some commands like \tcode have a different meaning
, inComment :: Bool -- in comments, \tcode should not be highlighted
, inSectionTitle :: Bool -- in section titles, there should be no highlighting
, replXmlChars :: Bool -- replace < with <, etc
, noTags :: Bool -- means we're rendering the contents of e.g. a "title" attribute which cannot contain tags/elements
, extraIndentation :: Int -- in em
, idPrefixes :: [Text] }
defaultRenderContext :: RenderContext
defaultRenderContext = RenderContext
{ page = error "no page"
, draft = error "no draft"
, nearestEnclosing = error "no para/sec"
, rawHyphens = False
, rawTilde = False
, rawSpace = False
, insertBreaks = False
, inLink = False
, inCodeBlock = False
, inComment = False
, inSectionTitle = False
, replXmlChars = True
, noTags = False
, extraIndentation = 0
, idPrefixes = [] }
squareAbbr :: Bool -> Abbreviation -> TextBuilder.Builder
squareAbbr softHyphens =
("[" ++) . (++ "]") .
TextBuilder.fromText .
(if softHyphens then Text.replace "." "." else id)
parentLink :: Section -> Abbreviation -> Text
parentLink parent child
| Just sub <- Text.stripPrefix (abbreviation parent ++ ".") child = sub
| otherwise = child
abbrHref :: Abbreviation -> RenderContext -> Text
abbrHref abbr RenderContext{..}
| SectionPage sec <- page, abbreviation sec == abbr = "#"
| abbrIsOnPage abbr page = "#" ++ case page of
SectionPage sec -> urlChars (parentLink sec abbr)
TablesPage | Just abbr' <- Text.stripPrefix "tab:" abbr -> urlChars abbr'
_ -> urlChars abbr
| "fig:" `isPrefixOf` abbr =
let Figure{figureSection=Section{..}, ..} = figureByAbbr draft abbr
in "SectionToSection/" ++ urlChars abbr ++ "#" ++ urlChars figureAbbr
| "eq:" `isPrefixOf` abbr =
let Formula{formulaSection=Section{..}, ..} = formulaByAbbr draft abbr
in "SectionToSection/" ++ urlChars abbr ++ "#" ++ urlChars formulaAbbr
| "tab:" `isPrefixOf` abbr =
case tableByAbbr draft abbr of
Just Table{tableSection=Section{..}, ..} -> "SectionToSection/" ++ urlChars abbreviation ++ "#" ++ urlChars tableAbbr
_ -> "#" ++ urlChars abbr
| otherwise = linkToSectionHref SectionToSection abbr
prepMath :: LaTeX -> String
prepMath = Text.unpack . renderLaTeX . (>>= cleanup) . replaceTcode
where
replaceTcode = mapCommandName (\x -> if x == "tcode" then "texttt" else x)
cleanupText :: LaTeX -> LaTeX -- MathJax does not support \, in \text
cleanupText [] = []
cleanupText (TeXComm "," _ [] : x) = TeXRaw " " : cleanupText x
cleanupText (x : y) = cleanup x ++ cleanupText y
cleanup :: LaTeXUnit -> LaTeX
cleanup (TeXComm "texttt" _ [(FixArg, TeXComm "texttt" "" [(FixArg, x)] : y)]) =
cleanup (TeXComm "texttt" "" [(FixArg, x ++ y)])
cleanup (TeXComm "texttt" _ [(FixArg, TeXRaw x : y)]) =
TeXComm "texttt" "" [(FixArg, [TeXRaw x])] : cleanup (TeXComm "texttt" "" [(FixArg, y)])
cleanup (TeXComm "texttt" _ [(FixArg, TeXComm "textit" "" x : y)]) =
[TeXComm "class" "" [(FixArg, [TeXRaw "textit"]), (FixArg, [TeXComm "texttt" "" x])]]
++ cleanup (TeXComm "texttt" "" [(FixArg, y)])
-- \texttt{\textit{x}y} -> \class{textit}{\texttt{x}}\texttt{y}
-- MathJax does not support \textit inside \texttt
cleanup (TeXComm "nontcode" _ x) = [TeXComm "texttt" "" (map (second (>>= cleanup)) x)]
cleanup (TeXComm "ensuremath" _ [(FixArg, x)]) = x >>= cleanup
cleanup (TeXComm "discretionary" _ _) = []
cleanup (TeXComm "hfill" _ []) = []
cleanup (TeXComm "text" ws [(FixArg, x)]) = [TeXComm "text" ws [(FixArg, cleanupText x)]]
cleanup (TeXComm "break" _ []) = []
cleanup (TeXComm "br" _ []) = []
cleanup (TeXComm "-" _ []) = []
cleanup (TeXComm "quad" _ []) = [TeXRaw " "] -- because MathJax does not support \quad
cleanup (TeXComm x ws y) = [TeXComm x ws (map (second (>>= cleanup)) y)]
cleanup x@(TeXRaw _) = [x]
cleanup (TeXBraces x) = [TeXBraces (x >>= cleanup)]
cleanup (TeXEnv x y z) = [TeXEnv x (map (second (>>= cleanup)) y) (z >>= cleanup)]
cleanup (TeXMath Dollar [c@(TeXComm "text" _ _)]) = cleanup c
-- because the draft sources have \bigoh{$\text{bla}$}, which MathJax doesn't support
cleanup (TeXMath x y) = [TeXMath x (y >>= cleanup)]
cleanup x@TeXLineBreak = [x]
renderMath :: LaTeX -> RenderContext -> TextBuilder.Builder
renderMath [TeXMath Dollar (c@(TeXComm "noncxxtcode" _ _) : more)] ctx =
render c ctx ++ renderMath [TeXMath Dollar more] ctx
renderMath m ctx
| noTags ctx = renderSimpleMath m ctx
| hasComplexMath True m = renderComplexMath (mapTeX replaceNonCxxTcode m) ctx
| otherwise = spanTag (mathKind m) $ renderSimpleMath m ctx
where
mathKind [TeXMath Square _] = "mathblock"
mathKind _ = "math"
replaceNonCxxTcode :: LaTeXUnit -> Maybe LaTeX
replaceNonCxxTcode (TeXComm "noncxxtcode" _ args) = Just [TeXComm "tcode" "" args]
replaceNonCxxTcode _ = Nothing
renderSimpleMath :: LaTeX -> RenderContext -> TextBuilder.Builder
renderSimpleMath [] _ = ""
renderSimpleMath (TeXRaw s : rest) sec
| tlast `elem` ["^", "_"] = if noTags sec then "�" else
renderSimpleMathUnit (TeXRaw $ Text.reverse $ Text.drop 1 s') sec
++ xml tag [] (renderSimpleMath content sec)
++ renderSimpleMath rest' sec
| otherwise = renderSimpleMathUnit (TeXRaw s) sec ++ renderSimpleMath rest sec
where
s' = Text.reverse s
tlast = Text.take 1 s'
tag = case tlast of
"^" -> "sup"
"_" -> "sub"
_ -> error ""
(content, rest') = case rest of
(a : b) -> ([a], b)
other -> (other, [])
renderSimpleMath (TeXComm "frac" _ [(FixArg, num)] : rest) sec =
"[" ++ renderSimpleMath num sec ++ "] / [" ++ renderSimpleMath den sec ++ "]" ++ renderSimpleMath rest' sec
where
(den, rest') = findDenum rest
findDenum (TeXBraces d : r) = (d, r)
findDenum (_ : r) = findDenum r
findDenum r = (r, [])
renderSimpleMath (x : y) ctx = renderSimpleMathUnit x ctx ++ renderSimpleMath y ctx
renderSimpleMathUnit :: LaTeXUnit -> RenderContext -> TextBuilder.Builder
renderSimpleMathUnit (TeXRaw s) sec =
case suffix of
Just ('^', rest) -> if noTags sec then "�" else italicise prefix ++ output "sup" rest
Just ('_', rest) -> if noTags sec then "�" else italicise prefix ++ output "sub" rest
_ -> italicise s
where
(prefix, suffix') = Text.break (`elem` ['^', '_']) s
suffix = Text.uncons suffix'
output :: Text -> Text -> TextBuilder.Builder
output tag rest =
case Text.uncons rest of
Just (c, rest') -> xml tag [] (italicise $ Text.singleton c) ++ (renderSimpleMathUnit (TeXRaw rest') sec)
Nothing -> error "Malformed math"
italicise :: Text -> TextBuilder.Builder
italicise t = if noTags sec then TextBuilder.fromText t else
case Text.span isAlpha t of
("", "") -> TextBuilder.fromString ""
("", rest) ->
case Text.uncons rest of
Just (c, rest') -> entities c ++ italicise rest'
Nothing -> error ""
(alpha, rest) -> spanTag "mathalpha" (TextBuilder.fromText alpha) ++ italicise rest
entities :: Char -> TextBuilder.Builder
entities '<' = "<"
entities '>' = ">"
entities c = TextBuilder.singleton c
renderSimpleMathUnit (TeXComm "mathtt" _ [(FixArg, x)]) ctx = spanTag "mathtt" (highlight ctx x)
renderSimpleMathUnit (TeXBraces x) sec = renderSimpleMath x sec
renderSimpleMathUnit (TeXMath Dollar m) sec = renderSimpleMath (trim m) sec
renderSimpleMathUnit (TeXMath _ m) sec = renderSimpleMath m sec
renderSimpleMathUnit other sec = render other sec
mathKey :: LaTeX -> (String, Bool)
mathKey m = case m of
[TeXMath kind t] -> (prepMath t, kind == Dollar)
[TeXEnv "eqnarray*" [] _] -> (prepMath m, False)
[TeXEnv "equation*" [] _] -> (prepMath m, False)
_ -> (prepMath m, True)
highlightCodeInMath :: RenderContext -> [Soup.Tag Text] -> TextBuilder.Builder
highlightCodeInMath ctx
( open@(Soup.TagOpen "span" (("class", cls) : _))
: Soup.TagText code
: close@(Soup.TagClose "span")
: more )
| cls `elem` ["mjx-char MJXc-TeX-type-R", "mjx-charbox MJXc-TeX-type-R"]
= TextBuilder.fromText (Soup.renderTags [open])
++ highlight ctx [TeXRaw code]
++ TextBuilder.fromText (Soup.renderTags [close])
++ highlightCodeInMath ctx more
highlightCodeInMath ctx (a:b) = TextBuilder.fromText (Soup.renderTags [a]) ++ highlightCodeInMath ctx b
highlightCodeInMath _ [] = ""
{- Unfortunately, for: \class{hidden_link}{\href{url}{bla}}
MathJax generates: bla
But CSS does not let you say "apply the following style to 'a' elements that have a 'span' child with class 'hidden_link'".
So fixHiddenLinks moves the "hidden_link" class from the span to the a... -}
fixHiddenLinks :: [Soup.Tag Text] -> [Soup.Tag Text]
fixHiddenLinks (Soup.TagOpen "a" attrs : Soup.TagOpen "span" [("class", Text.words -> cls)] : rest)
| "hidden_link" `elem` cls
= Soup.TagOpen "a" (("class", "hidden_link") : attrs) :
Soup.TagOpen "span" [("class", Text.unwords $ cls \\ ["hidden_link"])] : rest
fixHiddenLinks (x:y) = x : fixHiddenLinks y
fixHiddenLinks [] = []
removeAriaLabel :: Soup.Tag Text -> Soup.Tag Text
removeAriaLabel (Soup.TagOpen x attrs) = Soup.TagOpen x (filter ((/= "aria-label") . fst) attrs)
removeAriaLabel x = x
doRenderComplexMath :: LaTeX -> RenderContext -> TextBuilder.Builder
doRenderComplexMath math ctx =
(if inComment ctx then TextBuilder.fromText . Soup.renderTags else highlightCodeInMath ctx) $
fixHiddenLinks $ map removeAriaLabel $ Soup.parseTags $ MathJax.render formula inline
where (formula, inline) = mathKey math
renderComplexMath :: LaTeX -> RenderContext -> TextBuilder.Builder
renderComplexMath math ctx = (if inline then "" else "
") ++ spanTag "math" (doRenderComplexMath math ctx)
where (_, inline) = mathKey math
cssClasses :: ColumnSpec -> Text
cssClasses (ColumnSpec alignment border _) =
(if border then "border " else "") ++ Text.pack (show alignment)
cssStyle :: ColumnSpec -> Maybe Text
cssStyle (ColumnSpec _ _ (Just w)) = Just $ "width:" ++ w
cssStyle _ = Nothing
renderTable :: [ColumnSpec] -> [Row [TeXPara]] -> RenderContext -> TextBuilder.Builder
renderTable colspec a = \ctx -> xml "table" [] $ mconcat (renderRow ctx . zip [1..] a)
where
combine (ColumnSpec x False w) (ColumnSpec _ True _) = ColumnSpec x True w
combine x _ = x
renderRow :: RenderContext -> (Integer, Row [TeXPara]) -> TextBuilder.Builder
renderRow ctx (rowNum, Row{..}) =
xml "tr" ([("id", rowId)] ++ cls) (renderCols ctx' rowId colspec 1 clines cells)
where
rowId = mconcat (idPrefixes ctx) ++ "row-" ++ Text.pack (show rowNum)
ctx' = ctx{idPrefixes = idPrefixes ctx ++ ["row-" ++ Text.pack (show rowNum) ++ "-"]}
cls | RowSep <- rowSep = [("class", "rowsep")]
| CapSep <- rowSep = [("class", "capsep")]
| otherwise = []
clines
| Clines clns <- rowSep = clns
| otherwise = []
renderCols :: RenderContext -> Text -> [ColumnSpec] -> Int -> [(Int, Int)] -> [Cell [TeXPara]] -> TextBuilder.Builder
renderCols _ _ _ _ _ [] = ""
renderCols ctx rowId (c : cs) colnum clines (Cell{..} : rest)
| length cs < length rest = undefined
| Multicolumn w cs' <- cellSpan =
let
cs'' = combine cs' c
colspan
| null rest = length cs + 1
| otherwise = w
in
renderCell colspan (cssClasses cs'' ++ clineClass colnum clines) (cssStyle cs'') cnt
++ renderCols ctx rowId (drop (colspan - 1) cs) (colnum + colspan) clines rest
| otherwise =
renderCell 1 (cssClasses c ++ clineClass colnum clines) (cssStyle c) cnt
++ renderCols ctx rowId cs (colnum + 1) clines rest
where
marginalizedLink = xml "div" [("class", "marginalizedparent")] (render link ctx)
link = anchor{aClass="itemDeclLink", aHref="#" ++ urlChars rowId, aText="🔗"}
cnt = (if colnum == 1 then marginalizedLink else "") ++ renderLatexParas content ctx'
ctx' = ctx{idPrefixes = idPrefixes ctx ++ ["column-" ++ Text.pack (show colnum) ++ "-"]}
renderCols _ _ [] _ _ (_ : _) = error "Too many columns"
clineClass n clines
| isJust $ find (\(begin, end) -> begin <= n && n <= end) clines =
" cline"
| otherwise = ""
renderCell :: Int -> Text -> Maybe Text -> TextBuilder.Builder -> TextBuilder.Builder
renderCell colspan classes style content = xml "td" attrs content
where
classes' = if TextBuilder.toLazyText content == "" then "empty " ++ classes else classes
attrs = [("colspan", Text.pack $ show colspan) | colspan /= 1]
++ [("class", classes')]
++ [("style", s) | Just s <- [style]]
instance Render TeXPara where
render = (mconcat .) . (intersperse " " .) . mapM render . sentences
instance Render [Element] where
render l@(LatexElement _ : _) ctx = render (spanJust l p) ctx
where
p (LatexElement e) = Just e
p _ = Nothing
render (x : y) ctx = render x ctx ++ render y ctx
render [] _ = ""
instance Render Sentence where
render Sentence{..} ctx
| (Enumerated _ _ : _) <- sentenceElems = render sentenceElems ctx -- not a real sentence
| not (noTags ctx), Just v <- i
= xml "div" [("id", v), ("class", "sentence")] $
render (case linkifyFullStop link sentenceElems of Just x -> x; Nothing -> sentenceElems) ctx
| otherwise = render sentenceElems ctx
where
i = case sentenceNumber of
Just v -> Just $ mconcat (idPrefixes ctx) ++ "sentence-" ++ Text.pack (show v)
Nothing -> Nothing
link = TeXComm "class" ""
[ (FixArg, [TeXRaw "hidden_link"])
, (FixArg, [TeXComm "href" "" [(FixArg, [TeXRaw ("#" ++ fromJust i)]), (FixArg, [TeXRaw "."])]])
] -- in math, \class and \href are recognized by mathjax
renderLatexParas :: [TeXPara] -> RenderContext -> TextBuilder.Builder
renderLatexParas pp ctx = mconcat $ map (xml "div" [("class", "texpara")] . flip render ctx) pp
-- Explicit
's are redundant in , so strip them.
preprocessPre :: LaTeX -> LaTeX
preprocessPre = concatMap f
where
f TeXLineBreak = []
f (TeXComm "br" _ []) = []
f (TeXEnv e a c) = [TeXEnv e a (preprocessPre c)]
f x = [x]
htmlTabs :: Text -> Text
htmlTabs = replace "\t" " " -- todo: still necessary?
linkToSectionHref :: Link -> Abbreviation -> Text
linkToSectionHref link abbr = Text.pack (show link) ++ "/" ++ urlChars abbr
linkToSection :: Link -> Abbreviation -> Anchor
linkToSection link abbr = anchor{ aHref = linkToSectionHref link abbr, aText = squareAbbr True abbr }
--url :: Text -> Text
--url = urlChars . LazyText.toStrict . TextBuilder.toLazyText . flip render defaultRenderContext{replXmlChars = False}
simpleRender :: Render a => a -> Text
simpleRender = LazyText.toStrict . TextBuilder.toLazyText . simpleRender2
simpleRender2 :: Render a => a -> TextBuilder.Builder
simpleRender2 = flip render defaultRenderContext
secnum :: Int -> Text -> Section -> TextBuilder.Builder
secnum reduceIndent href se@Section{..} =
simpleRender2 (anchor{aClass=c, aHref=href, aText=secnumText se, aStyle=Text.pack style})
where
style = "min-width:" ++ show (50 + (length parents - reduceIndent) * 15) ++ "pt"
c | chapter /= NormalChapter, null parents = "annexnum"
| otherwise = "secnum"
secnumText :: Section -> TextBuilder.Builder
secnumText Section{sectionNumber=n,..}
| chapter == InformativeAnnex, null parents = "Annex " ++ chap ++ " (informative)"
| chapter == NormativeAnnex, null parents = "Annex " ++ chap ++ " (normative)"
| otherwise = intercalateBuilders "." (chap : simpleRender2 . tail ns)
where
ns = reverse $ n : sectionNumber . parents
chap :: TextBuilder.Builder
chap
| chapter == NormalChapter = simpleRender2 (head ns)
| otherwise = TextBuilder.singleton $ ['A'..] !! head ns
================================================
FILE: SectionPages.hs
================================================
{-# OPTIONS_GHC -fno-warn-tabs #-}
{-# LANGUAGE OverloadedStrings, RecordWildCards, TupleSections, ViewPatterns, NamedFieldPuns #-}
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 LaTeXBase (LaTeXUnit(..))
import Pages (writePage, pageContent, pagePath, PageStyle(..), fileContent, outputDir, Link(..))
import Render (render, concatRender, simpleRender2, renderFig, abbrHref,
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
tocSection :: RenderContext -> Section -> TextBuilder.Builder
tocSection _ Section{sectionKind=DefinitionSection _} = ""
tocSection ctx s@Section{..} = header ++ mconcat (tocSection ctx . subsections)
where
header = h (min 4 $ 1 + length parents) $
secnum 0 "" s ++ " "
++ render ( sectionName ++ [TeXRaw " "]
, anchor{ aHref = abbrHref abbreviation ctx, aText = squareAbbr True abbreviation, aClass="abbr_ref" })
ctx{ inSectionTitle = True }
++ ""
renderSection :: RenderContext -> Maybe Section -> Bool -> Section -> (TextBuilder.Builder, Bool)
renderSection context specific parasEmitted s@Section{abbreviation, subsections, sectionFootnotes, paragraphs}
| full = (, True) $
idDiv header ++
(if specific == Just s && any (not . isDefinitionSection . sectionKind) subsections then toc else "") ++
mconcat (map
(\p -> renderParagraph (context{nearestEnclosing=Left p,idPrefixes=if parasEmitted then [secOnPage ++ "-"] else []}))
paragraphs) ++
(if null sectionFootnotes then "" else "") ++
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
reduceHeaderIndent = case page context of
SectionPage p | specific == Nothing -> length (parents p) + 1
_ -> 0
header = sectionHeader reduceHeaderIndent (min 4 $ 1 + length (parents s)) s
(if specific == Nothing && isSectionPage (page context) then "#" ++ urlChars secOnPage else "")
abbr context
toc = "
" ++ mconcat (tocSection context . subsections) ++ "
"
abbr
| specific == Just s && not (null (parents s))
= anchor
| Just sp <- specific, sp /= s, not (null (parents s))
= anchor{aHref = "SectionToSection/" ++ urlChars abbreviation ++ "#" ++ parentLink s (Document.abbreviation sp)}
| otherwise = linkToSection
(if null (parents s) 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 =
"" ++
"" ++
""
writeSectionFile :: FilePath -> PageStyle -> TextBuilder.Builder -> TextBuilder.Builder -> IO ()
writeSectionFile n sfs title body = writePage n sfs (sectionFileContent sfs title body)
sectionHeader :: Int -> Int -> Section -> Text -> Anchor -> RenderContext -> TextBuilder.Builder
sectionHeader reduceIndent 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 reduceIndent 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" $
""
++ 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" $
""
++ 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" $
"List of Footnotes
"
++ 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 0 (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 0 (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}
================================================
FILE: Sentences.hs
================================================
{-# LANGUAGE OverloadedStrings, ViewPatterns, LambdaCase, TypeSynonymInstances, FlexibleInstances #-}
module Sentences (splitIntoSentences, isActualSentence, linkifyFullStop, breakSentence) where
import LaTeXBase (LaTeXUnit(..), triml, ArgKind(FixArg))
import Data.Text (isPrefixOf, isSuffixOf, stripPrefix, Text)
import qualified Data.Text as Text
import Prelude hiding (take, (.), takeWhile, (++), lookup, readFile)
import Data.Char (isSpace, isDigit, isAlphaNum, isUpper, isLower)
import Control.Arrow (first)
import Data.Maybe (isNothing)
import Util ((++), textStripInfix, dropTrailingWs, (.))
import RawDocument
import Document
startsSentence :: RawElement -> Bool
startsSentence (RawLatexElement e) | [TeXRaw x] <- triml [e], x /= "" = isUpper (Text.head x)
startsSentence _ = False
unitContinuesSentence :: LaTeXUnit -> Bool
unitContinuesSentence (TeXComm " " _ []) = True
unitContinuesSentence (TeXRaw txt) = "," `isPrefixOf` txt
unitContinuesSentence _ = False
elemContinuesSentence :: RawElement -> Bool
elemContinuesSentence (RawLatexElement u) = unitContinuesSentence u
elemContinuesSentence _ = False
elemsContinueSentence :: [RawElement] -> Bool
elemsContinueSentence (RawLatexElement (TeXRaw "") : more) = elemsContinueSentence more
elemsContinueSentence (x : _) = elemContinuesSentence x
elemsContinueSentence _ = False
simpleHead :: [RawElement] -> Maybe Char
simpleHead [] = Nothing
simpleHead (RawLatexElement (TeXRaw x) : more)
| x == "" = simpleHead more
| otherwise = Just (Text.head x)
simpleHead (RawLatexElement (TeXComm " " "" []) : _) = Just ' '
simpleHead (RawLatexElement (TeXComm "tcode" _ [(_, x)]) : more) = simpleHead (map RawLatexElement x ++ more)
simpleHead (RawLatexElement (TeXComm "index" _ _) : more) = simpleHead more
simpleHead (RawLatexElement (TeXComm "footnoteref" _ _) : _) = Nothing -- hmm
simpleHead (RawLatexElement TeXLineBreak : _) = Nothing
simpleHead (RawLatexElement (TeXComm "br" _ _) : _) = Nothing
simpleHead (RawLatexElement (TeXComm "linebreak" _ _) : _) = Nothing
simpleHead (RawLatexElement (TeXComm "newline" _ _) : _) = Nothing
simpleHead (RawLatexElement (TeXComm "par" _ _) : _) = Nothing
simpleHead (RawLatexElement (TeXComm "nolinebreak" _ _) : _) = Nothing
simpleHead (RawLatexElement (TeXComm "iref" _ _) : _) = Nothing
simpleHead (RawLatexElement (TeXComm "," _ _) : _) = Just ','
simpleHead x = error $ "simpleHead: " ++ show x
splitIntoSentences :: [RawElement] -> [[RawElement]]
splitIntoSentences = go []
where
go [] [] = []
go [] (RawLatexElement (TeXRaw "\n") : y) = go [] y
go [] (x@(RawExample _) : y) = [x] : go [] y
go [] (x@(RawNote _ _) : y) = [x] : go [] y
go partial (x@(RawCodeblock _) : y) | z : _ <- rmIndices y, startsSentence z = (partial ++ [x]) : go [] y
go x [] = [x]
go x z@(e : y)
| Just (s, rest) <- breakSentence z = (x ++ s) : go [] rest
| otherwise = go (x ++ [e]) y
rmIndices (RawLatexElement (TeXRaw "\n") : RawLatexElement (TeXComm "index" _ _) : x) = rmIndices x
rmIndices x = x
breakSentence :: [RawElement] -> Maybe ([RawElement] {- sentence -}, [RawElement] {- remainder -})
breakSentence (e@(RawLatexElement (TeXMath _ math)) : more)
| f (reverse math) = Just ([e], more)
| otherwise = first (e :) . breakSentence more
where
f :: LaTeX -> Bool
f (TeXRaw y : z) | all isSpace (Text.unpack y) = f z
f (TeXComm "text" _ [(FixArg, a)] : _) = f (reverse a)
f (TeXComm "mbox" _ [(FixArg, a)] : _) = f (reverse a)
f (TeXRaw ".\n" : TeXComm "right" "" [] : y) = f y
f (TeXRaw y : _) = "." `isSuffixOf` (Text.pack $ dropTrailingWs $ Text.unpack y)
f _ = False
breakSentence (b@(RawLatexElement TeXLineBreak) : more) = Just ([b], more)
breakSentence (RawLatexElement (TeXBraces x) : more) = breakSentence (map RawLatexElement x ++ more)
breakSentence (e@(RawLatexElement (TeXEnv "eqnarray*" _ _)) : more) = first (e :) . breakSentence more
breakSentence (b@(RawLatexElement (TeXComm cmd _ _)) : more) =
if cmd `elem` ["break"]
then Just ([b], more)
else (first (b :)) . breakSentence more
breakSentence (e@(RawLatexElement (TeXRaw (textStripInfix "." -> (Just ((++ ".") -> pr, po))))) : more)
= f pr po
where
f :: Text -> Text -> Maybe ([RawElement], [RawElement])
f pre post
| "''" `isPrefixOf` post = f (pre ++ "''") (Text.drop 2 post)
| not (("(." `isSuffixOf` pre) && (")" `isPrefixOf` post))
, not ("" == post && maybe False (\c -> isLower c || isDigit c) (simpleHead more))
, not ("" == post && length more /= 0 && head more == RawLatexElement (TeXComm " " "" []))
, not (Text.length post > 0 && ((Text.head post == '.')
|| isLower (Text.head post)
|| isDigit (Text.head post)))
, not (Text.length pre > 1 && Text.length post > 0 && isAlphaNum (Text.last $ Text.init pre) && isDigit (Text.head post))
, not (elemsContinueSentence (RawLatexElement (TeXRaw post) : more))
, not (Text.length pre >= 2 && ("." `isSuffixOf` pre) && isUpper (Text.last $ Text.init pre))
, not ("e.g." `isSuffixOf` pre)
, not ("i.e." `isSuffixOf` pre) =
let
post' = Text.stripStart post
(pre', post'') = case stripPrefix ")" post' of
Just z -> (pre ++ ")" , Text.stripStart z)
Nothing -> (pre, post')
more' = if post'' == "" then more else RawLatexElement (TeXRaw post'') : more
(maybefootnote, more'') = case more' of
fn@(RawLatexElement (TeXComm "footnoteref" _ _)) : z -> ([fn], z)
_ -> ([], more')
sentence = [RawLatexElement (TeXRaw pre')] ++ maybefootnote
in
Just (sentence, more'')
| Just ((++ ".") -> pre', post') <- textStripInfix "." post = f (pre ++ pre') post'
| otherwise = first (e :) . breakSentence more
breakSentence (e@(RawLatexElement (TeXRaw _)) : more) = first (e :) . breakSentence more
breakSentence (enum@(RawEnumerated _ (last -> rawItemContent -> (_ : _ : _))) : more)
= Just ([enum], more)
breakSentence (enum@(RawEnumerated _ (last -> rawItemContent -> [RawTexPara y])) : more)
| Just _ <- breakSentence y = Just ([enum], more)
breakSentence _ = Nothing
isActualSentence :: [RawElement] -> Bool
isActualSentence (RawEnumerated _ _ : _) = False
isActualSentence l = any p l
where
yes = words $
"link tcode noncxxtcode textit ref grammarterm indexedspan " ++
"defnx textbf textrm textsl textsc indexlink hiddenindexlink"
q :: LaTeXUnit -> Bool
q (TeXRaw s) = not $ all isSpace $ Text.unpack s
q (TeXComm c _ _) | c `elem` yes = True
q (TeXEnv c _ _) | c `elem` yes = True
q (TeXEnv "indexed" _ body) = any q body
q (TeXBraces body) = any q body
q _ = False
p :: RawElement -> Bool
p (RawLatexElement u) = q u
p RawEnumerated{} = True
p _ = False
class LinkifyFullStop a where
linkifyFullStop :: LaTeXUnit -> a -> Maybe a
instance LinkifyFullStop LaTeX where
linkifyFullStop link l = reverse . f (reverse l)
where
f [] = Nothing
f (x@(TeXRaw ".\n") : y@(TeXComm "right" _ _) : more) = ([x, y] ++) . f more
f (u : uu)
| Just u' <- inUnit u = Just (reverse u' ++ uu)
| otherwise = (u :) . f uu
inUnit :: LaTeXUnit -> Maybe LaTeX -- returns content in regular order
inUnit (TeXEnv "array" args body)
| Just body' <- linkifyFullStop link body = Just [TeXEnv "array" args body']
inUnit (TeXEnv "indented" [] body)
| Just body' <- linkifyFullStop link body = Just [TeXEnv "indented" [] body']
inUnit (TeXComm "text" ws [(FixArg, x)])
| Just x' <- linkifyFullStop link x = Just (moveStuffOutsideText (TeXComm "text" ws [(FixArg, x')]))
| otherwise = Nothing
inUnit (TeXComm "mbox" ws [(FixArg, x)])
| Just x' <- linkifyFullStop link x = Just (moveStuffOutsideText (TeXComm "mbox" ws [(FixArg, x')]))
| otherwise = Nothing
inUnit (TeXMath kind m)
| Just m' <- linkifyFullStop link m = Just [TeXMath kind m']
inUnit (TeXRaw (Text.dropWhileEnd (=='\n') -> Text.stripSuffix "." -> Just s)) = Just [TeXRaw s, link]
inUnit (TeXRaw (Text.stripSuffix ".)" -> Just s)) = Just [TeXRaw s, link, TeXRaw ")"]
inUnit (TeXRaw (Text.stripSuffix ".''" -> Just s)) = Just [TeXRaw s, link, TeXRaw "''"]
inUnit _ = Nothing
instance LinkifyFullStop Item where
linkifyFullStop link it@Item{itemInlineContent=e}
| Just y <- linkifyFullStop link e
= Just it{itemInlineContent=y}
linkifyFullStop _ _ = Nothing
instance LinkifyFullStop [Element] where
linkifyFullStop link = (reverse .) . f . reverse
where
f :: [Element] -> Maybe [Element]
f (Enumerated cmd (reverse -> (lastItem : moreItems)) : more)
| all (isNothing . linkifyFullStop link) moreItems
, Just lastItem' <- linkifyFullStop link lastItem
= Just $ Enumerated cmd (reverse (lastItem' : moreItems)) : more
f (LatexElement u : more)
| Just u' <- linkifyFullStop link [u] = Just $ map LatexElement (reverse u') ++ more
| otherwise = (LatexElement u :) . f more
f _ = Nothing
moveStuffOutsideText :: LaTeXUnit -> LaTeX
-- Turns \text{ \class{bla} } into \text{ }\class{\text{bla}}\text{ }, and similar for \href,
-- because MathJax does not support \class and \href in \text.
moveStuffOutsideText (TeXComm parent pws [(FixArg, [TeXComm nested nws [x, y]])])
| parent `elem` ["text", "mbox"]
, nested `elem` ["class", "href"] = [TeXComm nested nws [x, (FixArg, moveStuffOutsideText (TeXComm parent pws [y]))]]
moveStuffOutsideText (TeXComm parent pws [(FixArg, t)])
| parent `elem` ["text", "mbox"]
, length t >= 2 = concatMap (\u -> moveStuffOutsideText $ TeXComm parent pws [(FixArg, [u])]) t
moveStuffOutsideText u = [u]
================================================
FILE: Setup.hs
================================================
import Distribution.Simple
main = defaultMain
================================================
FILE: Toc.hs
================================================
{-# OPTIONS_GHC -fno-warn-tabs #-}
{-# LANGUAGE RecordWildCards, OverloadedStrings, ViewPatterns, NamedFieldPuns #-}
module Toc (writeTocFiles) where
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LazyText
import qualified Data.Text.Lazy.Builder as TextBuilder
import Data.Time.Format (formatTime, defaultTimeLocale)
import Data.Time.Clock (getCurrentTime, UTCTime)
import Prelude hiding ((.), (++), writeFile)
import LaTeXBase (LaTeXUnit(..))
import Pages (Link(..), fileContent, applyPageStyle, PageStyle(..), outputDir, writePage)
import Render (secnum, linkToSection, simpleRender2, RenderContext(..), render, defaultRenderContext, Page(..))
import Util
import Document (Section(..), Draft(..), SectionKind(..), indexCatName, isDefinitionSection)
tocSection :: Draft -> Bool -> Section -> TextBuilder.Builder
tocSection _ _ Section{sectionKind=DefinitionSection _} = ""
tocSection draft expanded s@Section{..} =
xml "div" [("id", abbreviation)] $ header ++ mconcat (tocSection draft expanded . subsections)
where
header = h (min 4 $ 2 + length parents) $
secnum 0 (if expanded then "#" ++ urlChars abbreviation else "") s ++ " "
++ render ( sectionName ++ [TeXRaw " "]
, (linkToSection (if expanded then SectionToSection else TocToSection) abbreviation){aClass="abbr_ref"})
defaultRenderContext{page=if expanded then ExpandedTocPage else TocPage, inSectionTitle=True, draft=draft}
++ ""
tocChapter :: Draft -> Bool -> Section -> TextBuilder.Builder
tocChapter draft expanded s@Section{abbreviation, sectionName, subsections, parents} =
xml "div" [("id", abbreviation)] $
h (min 4 $ 2 + length parents) header ++
xml "div" [("class", "tocChapter")] (mconcat (tocSection draft expanded . subsections))
where
href
| expanded = "SectionToSection/" ++ urlChars abbreviation
| otherwise = (if any (not . isDefinitionSection . sectionKind) subsections then "#" else "TocToSection/") ++ urlChars abbreviation
link = anchor{
aClass = "folded_abbr_ref",
aText = TextBuilder.fromText $ "[" ++ abbreviation ++ "]",
aHref = href}
header
| abbreviation == "bibliography" =
render anchor{aText = "Bibliography", aHref = href}
defaultRenderContext{inSectionTitle=True, draft=draft}
| otherwise =
secnum 0 (if expanded then "#" ++ urlChars abbreviation else "") s ++ " " ++
render (sectionName ++ [TeXRaw " "], link) defaultRenderContext{inSectionTitle=True, draft=draft} ++
(if expanded then "" else simpleRender2 (linkToSection TocToSection abbreviation){aClass="unfolded_abbr_ref"})
tocHeader :: UTCTime -> Text -> Text
tocHeader date commitUrl =
"(Generated on " ++ Text.pack (formatTime defaultTimeLocale "%F" date)
++ " from the LaTeX sources"
++ " by cxxdraft-htmlgen."
++ " This is not an ISO publication.)"
++ "
"
++ "Note: this is an early draft. It's known to be incomplet and incorrekt, and it has lots of"
++ " bad"
++ " formatting."
writeTocFiles :: PageStyle -> Draft -> IO ()
writeTocFiles sfs draft@Draft{..} = do
date <- getCurrentTime
tocCss <- readFile "toc.css"
let
descMeta = ""
tocStyle = ""
writeFile (outputDir ++ "/index.html") $ applyPageStyle sfs $ LazyText.toStrict $ TextBuilder.toLazyText $
fileContent "" "Draft C++ Standard: Contents" (descMeta ++ tocStyle) $
"Working Draft
Programming Languages — C++
" ++
xml "div" [("class", "tocHeader")] (TextBuilder.fromText $ tocHeader date commitUrl) ++
"
Contents
" ++
mconcat (tocChapter draft False . chapters) ++
mconcat (h 2
. (\cat -> simpleRender2 anchor{aHref="TocToSection/" ++ cat, aText=indexCatName cat})
. ["generalindex", "grammarindex", "headerindex", "libraryindex", "conceptindex", "impldefindex"])
fullTocCss <- readFile "fulltoc.css"
let
fullTocStyle = ""
pathHome = if sfs == InSubdir then "../" else ""
writePage "fulltoc" sfs $ applyPageStyle sfs $ LazyText.toStrict $ TextBuilder.toLazyText $
fileContent pathHome "Draft C++ Standard: Contents" (descMeta ++ fullTocStyle) $
"Working Draft
Programming Languages — C++
" ++
xml "div" [("class", "tocHeader")] (TextBuilder.fromText $ tocHeader date commitUrl) ++
"
Contents
" ++
mconcat (tocChapter draft True . chapters) ++
mconcat (h 2
. (\cat -> simpleRender2 anchor{aHref="SectionToSection/" ++ cat, aText=indexCatName cat})
. ["generalindex", "grammarindex", "headerindex", "libraryindex", "conceptindex", "impldefindex"])
================================================
FILE: Util.hs
================================================
{-# OPTIONS_GHC -fno-warn-tabs #-}
{-# LANGUAGE TupleSections, OverloadedStrings, ViewPatterns #-}
module Util (
mconcat, (.), (++), Text, replace, xml, spanTag, h, getDigit, startsWith, urlChars,
anchor, Anchor(..), writeFile, readFile, greekAlphabet, mapLast, mapHead, stripInfix, dropTrailingWs,
textStripInfix, textSubRegex, splitOn, intercalateBuilders, replaceXmlChars, stripAnyPrefix, trimString,
spanJust, measure, partitionBy
) where
import Prelude hiding ((.), (++), writeFile)
import qualified Data.Text as Text
import qualified Data.Map as Map
import Data.List (stripPrefix, intersperse)
import Data.Char (ord, isDigit, isSpace)
import Data.Text (Text, replace)
import Data.Text.IO (writeFile)
import Data.Time (getCurrentTime, diffUTCTime)
import Control.Arrow (first)
import Text.Regex (subRegex, Regex)
import qualified Data.Text.Lazy.Builder as TextBuilder
(.) :: Functor f => (a -> b) -> (f a -> f b)
(.) = fmap
(++) :: Monoid a => a -> a -> a
(++) = mappend
xml :: Text -> [(Text, Text)] -> TextBuilder.Builder -> TextBuilder.Builder
xml t attrs = (TextBuilder.fromText ("<" ++ t ++ " " ++ Text.unwords (map f attrs) ++ ">") ++) . (++ TextBuilder.fromText (""))
where
f (n, v) = n ++ "='" ++ v ++ "'"
spanTag :: Text -> TextBuilder.Builder -> TextBuilder.Builder
spanTag = xml "span" . (:[]) . ("class",)
h :: Int -> TextBuilder.Builder -> TextBuilder.Builder
h = flip xml [] . ("h" ++) . Text.pack . show
data Anchor = Anchor
{ aClass, aId, aHref :: Text
, aText :: TextBuilder.Builder
, aStyle, aTitle :: Text }
intercalateBuilders :: TextBuilder.Builder -> [TextBuilder.Builder] -> TextBuilder.Builder
intercalateBuilders x y = mconcat $ intersperse x y
anchor :: Anchor
anchor = Anchor{aClass="", aId="", aHref="", aText=TextBuilder.fromText "", aStyle="", aTitle=""}
greekAlphabet :: [(String, Char)]
greekAlphabet =
[ ("alpha" , 'α')
, ("beta" , 'β')
, ("gamma" , 'γ')
, ("delta" , 'δ')
, ("mu" , 'μ')
, ("nu" , 'ν')
, ("lambda" , 'λ')
, ("pi" , 'π')
, ("phi" , 'φ')
, ("rho" , 'ρ')
, ("sigma" , 'σ')
, ("theta" , 'θ')
, ("zeta" , 'ζ')
, ("Gamma" , 'Γ')
, ("Sigma" , 'Σ')
, ("Pi" , 'Π') ]
mapLast :: (a -> a) -> [a] -> [a]
mapLast _ [] = []
mapLast f [x] = [f x]
mapLast f (x:xx) = x : mapLast f xx
mapHead :: (a -> a) -> [a] -> [a]
mapHead f (x:y) = f x : y
mapHead _ [] = []
getDigit :: Char -> Maybe Int
getDigit c
| isDigit c = Just $ ord c - ord '0'
| otherwise = Nothing
stripInfix :: Eq a => [a] -> [a] -> Maybe ([a], [a])
stripInfix p s | Just r <- stripPrefix p s = Just ([], r)
stripInfix p (hd:t) = first (hd:) . stripInfix p t
stripInfix _ _ = Nothing
textStripInfix :: Text -> Text -> Maybe (Text, Text)
textStripInfix inf (Text.breakOn inf -> (a, b))
| b == "" = Nothing
| otherwise = Just (a, Text.drop (Text.length inf) b)
startsWith :: (Char -> Bool) -> (Text -> Bool)
startsWith _ "" = False
startsWith p t = p (Text.head t)
dropTrailingWs :: String -> String
dropTrailingWs = reverse . dropWhile isSpace . reverse
urlChars :: Text -> Text
urlChars =
replace "'" "'" .
replace "<" "%3c" .
replace ">" "%3e" .
replace "\"" "%22" .
replace "#" "%23" .
replace "{" "%7b" .
replace "|" "%7c" .
replace "}" "%7d" .
replace "[" "%5b" .
replace "\\" "%5c" .
replace "]" "%5d" .
replace "^" "%5e" .
replace " " "%20" .
replace "%" "%25"
textSubRegex :: Regex -> String -> Text -> Text
textSubRegex pat repl txt = Text.pack $ subRegex pat (Text.unpack txt) repl
splitOn :: (a -> Bool) -> [a] -> [[a]]
splitOn _ [] = [[]]
splitOn sep (x:y)
| sep x = [] : splitOn sep y
| otherwise = mapHead (x :) $ splitOn sep y
replaceXmlChars :: Text -> Text
replaceXmlChars =
replace ">" ">" .
replace "<" "<" .
replace "&" "&"
stripAnyPrefix :: [Text] -> Text -> Maybe (Text, Text)
stripAnyPrefix [] _ = Nothing
stripAnyPrefix (x:y) z
| Just a <- Text.stripPrefix x z = Just (x, a)
| otherwise = stripAnyPrefix y z
trimString :: String -> String
trimString = reverse . dropWhile isSpace . reverse . dropWhile isSpace
spanJust :: [a] -> (a -> Maybe b) -> ([b], [a])
spanJust (x : z) f
| Just y <- f x = first (y :) (spanJust z f)
spanJust z _ = ([], z)
measure :: IO a -> IO (a, Float)
measure f = do
start <- getCurrentTime
r <- f
end <- getCurrentTime
return (r, realToFrac $ diffUTCTime end start)
partitionBy :: (Ord b, Eq b) => (a -> b) -> [a] -> [(b, [a])]
partitionBy f l = Map.assocs $ Map.fromListWith (flip (++)) [(f x, [x]) | x <- l]
================================================
FILE: colored.css
================================================
div.example {
display: block;
margin-top: 5pt;
margin-bottom: 5pt;
font-size: 11pt;
color: #bb00bb;
}
div.note {
display: block;
margin-top: 5pt;
margin-bottom: 5pt;
font-size: 11pt;
color: #bb00bb;
}
================================================
FILE: cxxdraft-htmlgen.cabal
================================================
name: cxxdraft-htmlgen
version: 0
synopsis: Converts C++ Standard draft documents from their LaTeX sources to HTML
license: PublicDomain
license-file: LICENSE
author: Eelis
maintainer: eelis@eelis.net
category: Text
build-type: Simple
extra-source-files: README
cabal-version: >=1.10
executable cxxdraft-htmlgen
main-is: genhtml.hs
other-modules: Load14882, Render, Util, SectionPages, Toc, Document, LaTeXBase, LaTeXParser, RawDocument, MathJax, Sentences, CxxParser, Pages
other-extensions: OverloadedStrings, RecordWildCards, TupleSections, ViewPatterns
build-depends: base >=4.6
, text >=1.2
, process >=1.1
, directory >=1.2
, hashable >=1.2
, containers >=0.5
, mtl >=2.2
, time >=1.4
, regex-compat-tdfa
, temporary
, parallel
, tagsoup
, monad-parallel
hs-source-dirs: .
default-language: Haskell2010
ghc-options: -Wall -fno-warn-tabs -threaded "-with-rtsopts=-N"
================================================
FILE: expanded.css
================================================
div.example {
display: block;
margin-top: 5pt;
margin-bottom: 5pt;
font-size: 9pt;
}
div.note {
display: block;
margin-top: 5pt;
margin-bottom: 5pt;
font-size: 9pt;
}
div.note .texttt { font-size: 9pt; }
div.example .texttt { font-size: 9pt; }
div.note .textsf { font-family: 'Noto Sans'; font-size: 9pt; }
div.example .textsf { font-family: 'Noto Sans'; font-size: 9pt; }
div.note .math { font-size: 9pt; }
div.example .math { font-size: 9pt; }
================================================
FILE: fulltoc.css
================================================
h1 { margin: 0.2em 5pt 0.2em 5pt; line-height: 1.5; }
h2 { margin: 0.2em 5pt 0.2em 5pt; border-bottom: 1px dashed rgba(0, 0, 0, 0.2); line-height: 1.5; }
h3 { margin: 0.2em 5pt 0.2em 5pt; border-bottom: 1px dashed rgba(0, 0, 0, 0.2); line-height: 1.5; }
h4 { margin: 0.1em 5pt 0.1em 5pt; border-bottom: 1px dashed rgba(0, 0, 0, 0.2); line-height: 1.5; }
:target h2 { border-bottom: none; }
.tocHeader { text-align: center; }
:target > div.tocChapter { display: block; }
@media (prefers-color-scheme: dark) {
h2 { border-bottom-color: #b0b0b05a; }
h3 { border-bottom-color: #b0b0b05a; }
h4 { border-bottom-color: #b0b0b05a; }
}
================================================
FILE: genhtml.hs
================================================
{-# OPTIONS_GHC -fno-warn-tabs #-}
{-# LANGUAGE LambdaCase, ViewPatterns, RecordWildCards, OverloadedStrings #-}
import Document (Draft(..))
import Load14882 (load14882)
import Prelude hiding ((++), (.), writeFile, readFile)
import System.Directory (createDirectoryIfMissing, setCurrentDirectory, getCurrentDirectory, copyFile)
import System.Environment (getArgs)
import Control.Monad (forM_)
import Data.Text.IO (readFile)
import qualified Control.Monad.Parallel as ParallelMonad
import Util hiding (readFile)
import Toc (writeTocFiles)
import Pages (outputDir, PageStyle(..))
import SectionPages
data CmdLineArgs = CmdLineArgs
{ repo :: FilePath
, sectionFileStyle :: PageStyle
, sectionToWrite :: Maybe String }
readCmdLineArgs :: [String] -> CmdLineArgs
readCmdLineArgs = \case
[repo, read -> sectionFileStyle, sec] -> CmdLineArgs{sectionToWrite=Just sec, ..}
[repo, read -> sectionFileStyle] -> CmdLineArgs{sectionToWrite=Nothing,..}
[repo] -> CmdLineArgs{sectionFileStyle=WithExtension,sectionToWrite=Nothing,..}
_ -> error "param: path/to/repo"
main :: IO ()
main = do
cwd <- getCurrentDirectory
CmdLineArgs{..} <- readCmdLineArgs . getArgs
extraMacros <- readFile "macros.tex"
setCurrentDirectory $ repo ++ "/source"
draft@Draft{..} <- load14882 extraMacros
setCurrentDirectory cwd
createDirectoryIfMissing True outputDir
copyFile "icon-light.png" (outputDir ++ "/icon-light.png")
copyFile "icon-dark.png" (outputDir ++ "/icon-dark.png")
forM_ ["expanded.css", "colored.css", "normative-only.css"] $
\f -> do
copyFile f (outputDir ++ "/" ++ f)
case sectionToWrite of
Just abbr -> writeSingleSectionFile sectionFileStyle draft abbr
Nothing -> do
let acts =
[ writeTocFiles sectionFileStyle draft
, writeCssFile
, writeFiguresFile sectionFileStyle draft
, writeFigureFiles sectionFileStyle draft
, writeFootnotesFile sectionFileStyle draft
, writeTablesFile sectionFileStyle draft
, writeTableFiles sectionFileStyle draft
] ++
writeXrefDeltaFiles sectionFileStyle draft ++
writeIndexFiles sectionFileStyle draft index ++
writeSectionFiles sectionFileStyle draft
((), took) <- measure $ ParallelMonad.sequence_ acts
putStrLn $ "Wrote files to " ++ outputDir ++ " in " ++ show (took * 1000) ++ "ms."
================================================
FILE: macros.tex
================================================
%% cxxdraft-htmlgen builtins:
%
% \link
% Link to section.
% arg 0: link text
% arg 1: section abbreviation
%
% \weblink
% arg 0: link text
% arg 1: URL
%
% \indexlink
% Link to indexed position.
% arg 0: link text
% arg 1: index category
% arg 2: index key
% arg 3: abbreviation of section to link to (empty to auto-resolve)
%
% \hiddenindexlink
% Hidden link to indexed position.
% arg 0: link text
% arg 1: index category
% arg 2: index key
% arg 3: abbreviation of section to link to (empty to auto-resolve)
%
% \indexedspan
% arg 0: text
% arg 1: indices (zero or more \index commands)
%% cxxdraft-htmlgen derived macros:
\newcommand{\linkx}[3]{\indexlink{#1}{generalindex}{#2}{#3}}
% Link to indexed position.
% arg 0: link text
% arg 1: generalindex key
% arg 2: section abbreviation
\newcommand{\deflinkx}[3]{\indexlink{#1}{generalindex}{#2|idxbfpage}{#3}}
% Link to definition.
% arg 0: link text
% arg 1: definition key
% arg 2: section abbreviation
\newcommand{\deflink}[2]{\deflinkx{#1}{#1}{#2}}
% Convenience macro for when the link
% text is also the definition key.
\newcommand{\libmemberrefx}[3]{\indexlink{\tcode{#1}}{libraryindex}{\idxcode{#2}!\idxcode{#3}}{}}
\newcommand{\libglobalref}[1]{\libglobalrefx{#1}{#1}}
\newcommand{\libglobalrefx}[2]{\indexlink{\tcode{#1}}{libraryindex}{\idxcode{#2}}{}}
\newcommand{\noncxxtcode}[1]{\tcode{#1}}
\newcommand{\literaltcode}[1]{\tcode{#1}}
\newcommand{\literalterminal}[1]{\terminal{##1}}
\newcommand{\noncxxterminal}[1]{\terminal{##1}}
\newcommand{\oldconceptref}[1]{\indexlink{\oldconcept{#1}}{generalindex}{\idxoldconcept{#1}}{}}
%% replacements for existing macros:
\newcommand{\defnoldconcept}[1]{\indexedspan{\oldconcept{#1}}{\indextext{\idxoldconcept{#1}}}}
\newcommand{\indexdefn}[1]{\indextext{#1|idxbfpage}}
\newcommand{\idxcode}[1]{#1@\tcode{#1}}
\newcommand{\nontermdef}[1]{\hiddenindexlink{\indexedspan{#1\textnormal{:}}{\indexgrammar{\idxgram{#1}}}}{grammarindex}{\idxgram{#1}|idxbfpage}{}}
\newcommand{\renontermdef}[1]{#1\,\textnormal{::}}
\newcommand{\fmtnontermdef}[1]{#1\,\textnormal{:}}
\newcommand{\locnontermdef}[1]{#1\,\textnormal{:}}
\newcommand{\grammarterm}[1]{\indexlink{\indexedspan{\gterm{#1}}{\indexgram{\idxgram{#1}}}}{grammarindex}{\idxgram{#1}|idxbfpage}{}}
\newcommand{\cite}[1]{\indexlink{[bib]}{bibliography}{#1}{bibliography}}
\newcommand{\libglobal}[1]{\indexedspan{\hiddenindexlink{#1}{libraryindex}{\idxcode{#1}}{}}{\indexlibraryglobal{#1}}}
\newcommand{\libmember}[2]{\indexedspan{\hiddenindexlink{#1}{libraryindex}{\idxcode{#2}!\idxcode{#1}}{}}{\indexlibrarymember{#1}{#2}}}
\newcommand{\libheader}[1]{\indexlink{\indexedspan{\tcode{<#1>}}{\indexhdr{#1}}}{headerindex}{\idxhdr{#1}|idxbfpage}{}}
\newcommand{\libheaderdef}[1]{\indexedspan{\tcode{<#1>}}{\indexheader{#1}}}
\newcommand{\libheaderrefx}[2]{\libheader{#1}}
\newcommand{\libconceptx}[2]{\indexlink{\indexedspan{\cname{#1}}{\indexconcept{\idxconcept{#2}}}}{conceptindex}{\idxconcept{#2}|idxbfpage}{}}
\newcommand{\libmacro}[1]{\indexedspan{\tcode{#1}}{\indexlibraryglobal{#1}}}
\newcommand{\libxmacro}[1]{\indexedspan{\tcode{__#1}}{\indexlibraryglobal{__#1}}}
\newcommand{\Range}[4]{#1\tcode{#3,\penalty2000{} #4}#2}
\newcommand{\deflibconcept}[1]{\hiddenindexlink{\indexedspan{\cname{#1}}{\indexlibrary{\idxconcept{#1}}\indexconcept{\idxconcept{#1}|idxbfpage}}}{conceptindex}{\idxconcept{#1}|idxbfpage}{}}
\newcommand{\defexposconcept}[1]{\hiddenindexlink{\indexedspan{\ecname{#1}}{\indexconcept{\idxexposconcept{#1}|idxbfpage}}}{conceptindex}{\idxexposconcept{#1}|idxbfpage}{}}
\newcommand{\defexposconceptnc}[1]{\defexposconcept{#1}}
\newcommand{\exposconcept}[1]{\indexlink{\indexedspan{\ecname{#1}}{\indexconcept{\idxexposconcept{#1}}}}{conceptindex}{\idxexposconcept{#1}|idxbfpage}{}}
\newcommand{\exposconceptx}[2]{\indexedspan{\ecname{#1}}{\indexconcept{\idxexposconcept{#2}}}}
\newcommand{\exposconceptnc}[1]{\exposconcept{#1}}
\newcommand{\keyword}[1]{\indexedspan{\tcode{#1}}{\indextext{\idxcode{#1}}}}
\newcommand{\itcorr}[1][]{}
\newcommand{\diffdef}[1]{\break\diffhead{#1}}
\newcommand{\defnx}[2]{\hiddenindexlink{\indexedspan{\textit{#1}}{\indexdefn{#2}}}{generalindex}{#2|idxbfpage}{}}
\newcommand{\defnxname}[1]{\indexedspan{\xname{#1}}{\indextext{\idxxname{#1}}}}
\newcommand{\defnadj}[2]{\indextext{#1 #2|see{#2, #1}}\defnx{#1 #2}{#2!#1}}
\newcommand{\defnadjx}[3]{\indextext{#1 #3|see{#3, #1}}\defnx{#1 #2}{#3!#1}}
\newcommand{\defnlibxname}[1]{\indexedspan{\xname{#1}}{\indexlibrary{\idxxname{#1}}}}
\newcommand{\descr}[1]{\textnormal{#1}}
\newcommand{\cv}{\mathit{cv}}
\newcommand{\texorpdfstring}[2]{#2}
\newcommand{\textunderscore}{_}
\newcommand{\emo}[1]{#1}
\newcommand{\bm}[1]{\textbf{#1}}
\newenvironment{LongTable}[3]
{
\newcommand{\continuedcaption}{\caption[]{#1 (continued)}}
\begin{htmlTable}{#1}{#2}{#3}
\begin{TableBase}
}
{
\bottomline
\end{TableBase}
\end{htmltable}
}
================================================
FILE: mathjax-batch
================================================
#! /usr/bin/env node
var mjAPI = require("mathjax-node");
var split = require("split");
mjAPI.config(
{ extensions: ""
, fontURL: "https://cdn.mathjax.org/mathjax/latest/fonts/HTML-CSS" });
mjAPI.start();
var math = '';
function processLine(line)
{
var format;
if (line == "NONINLINE") format = "TeX";
else if (line == "INLINE") format = "inline-TeX";
else
{
if (math != '') math += '\n';
math += line;
return;
}
mjAPI.typeset({
math: math, format: format, html: true, css: false,
speakText: true, ex: 6, width: 100, linebreaks: true
}, function (data) {
// todo: if (data.errors) abort
console.log(data.html)
console.log("DONE")
});
math = '';
}
process.stdin.pipe(split(/\n/, null, {trailing: false})).on('data', processLine)
================================================
FILE: normative-only.css
================================================
div.example { display: none; }
div.note { display: none; }
a.footnotenum { display: none; }
div.footnote { display: none; }
div.footnoteSeparator { display: none; }
.footnoteref { display: none; }
div.nonNormativeOnly { display: none; }
================================================
FILE: stack.yaml
================================================
resolver: lts-12.17
packages:
- .
extra-deps: []
flags: {}
extra-package-dbs: []
================================================
FILE: toc.css
================================================
h1 { margin: 0.2em 5pt 0.2em 5pt; line-height: 1.5; }
h2 { margin: 0.2em 5pt 0.2em 5pt; border-bottom: 1px dashed rgba(0, 0, 0, 0.2); line-height: 1.5; }
h3 { margin: 0.2em 5pt 0.2em 5pt; border-bottom: 1px dashed rgba(0, 0, 0, 0.2); line-height: 1.5; }
h4 { margin: 0.1em 5pt 0.1em 5pt; border-bottom: 1px dashed rgba(0, 0, 0, 0.2); line-height: 1.5; }
:target h2 { border-bottom: none; }
.tocHeader { text-align: center; }
div.tocChapter { display: none; }
:target > div.tocChapter { display: block; }
@media (prefers-color-scheme: dark) {
h2 { border-bottom-color: #b0b0b05a; }
h3 { border-bottom-color: #b0b0b05a; }
h4 { border-bottom-color: #b0b0b05a; }
}