mediawiki2latex 7.9.0.1 → 7.33
raw patch · 45 files changed
+8249/−5910 lines, 45 filesdep +blaze-markupdep +deepseqdep +hashable
Dependencies added: blaze-markup, deepseq, hashable, http-client, http-types, network-uri, strict, time, zip-archive
Files
- ChangeLog +145/−0
- document/headers/commands.tex +28/−1
- document/headers/defaultcolors.tex +2/−0
- document/headers/hyphenation.tex +1/−0
- document/headers/options.tex +1/−0
- document/headers/packages2.tex +1/−0
- document/headers/templates.tex +90/−0
- latex/my-head.tex +3/−2
- latex/my-tabhead.tex +1/−1
- latex/templates.user +81/−3
- mediawiki2latex.cabal +15/−8
- src/All.hs +405/−131
- src/Babel.hs +23/−3
- src/BaseFont.hs +28/−10
- src/Compiler.hs +104/−357
- src/Contributors.hs +0/−10
- src/Font.hs +0/−69
- src/FontTool.hs +41/−21
- src/GetImages.hs +40/−36
- src/Hex.hs +26/−11
- src/HtmlRenderer.hs +405/−0
- src/ImperativeState.hs +80/−30
- src/Join.hs +0/−11
- src/LatexRenderer.hs +2991/−2726
- src/Licenses.hs +18/−5
- src/Load.hs +162/−58
- src/Logger.hs +4/−2
- src/MagicStrings.hs +66/−61
- src/MakeChess.hs +0/−6
- src/MediaWikiParseTree.hs +11/−12
- src/MediaWikiParser.hs +2034/−1722
- src/MegaFont.hs +4/−2
- src/MyState.hs +36/−34
- src/Parallel.hs +55/−32
- src/Server.hs +566/−42
- src/SimpleContributors.hs +41/−37
- src/Static.hs +34/−3
- src/TableHelper.hs +116/−116
- src/Tools.hs +62/−40
- src/TouchJPEG.hs +0/−6
- src/UrlAnalyse.hs +144/−53
- src/WikiHelper.hs +93/−75
- src/WikiLinkHelper.hs +46/−46
- src/babel/zh +7/−0
- src/mediawiki2latex.hs +239/−128
+ ChangeLog view
@@ -0,0 +1,145 @@+Version 7.33+ * src+ amperand and "<" and ">" now work in sourcecode received via html+ some more toplevel function are now documented+ server now displayes running at wmflabs+ server now warns about time limit of one hour+ formulas inside image caption received of html work+ man page update+ source code pretty printed+Version 7.32+ * src+ tables now work with formulas inside them also+ webserver now links to installation instructions+Version 7.31+ * src+ tables now work again and superfloues mediawiki internal html elements removed+Version 7.30+ * src+ making it compile on debian buster+Version 7.29+ * src+ making server mode work again+Version 7.28+ * src+ wikipedia "Book" namespace mode added. ram usage optimized in this mode +Version 7.27+ * src+ xelatex compiler change, ttf file extension no more written out +Version 7.26+ * src+ added two new output formats: epub and odt+Version 7.25+ * src+ replaced deprecated call to parseUrl by call to parseRequest+Version 7.24+ * src+ bdi tags in list of figures as well as contributors removed+Version 7.23+ * src+ German Wikibook Mathe für nicht Freaks does compile now. + Formulas now work with Wikipedias new mathml markup.+Version 7.22+ * src+ English Bourne Shell Wikiboook and German Wikibook on complex+ numbers do compile now+Version 7.21+ * src+ Wikipedia does now only allow https but no more https. This bug was fixed with this release.+ Now mediawiki2latex only uses https request but does not support http anymore+Version 7.20+ * src+ mediawiki changed its html output concerning internal links. This caused a bug+ in mediawiki2latex causing wrong display of links in the pdf and latex+ documents generated. This bug has been fixed+Version 7.19+ * src+ server mode website now W3C validated HTML5. font scaling for tables which would not+ fit on a page otherwise optimized. superfluses values, needed only internaly for + sorting in normal webbrowsers, in sortable tables removed accoriding to + span style dispaly none+Version 7.18+ * src+ tables optimized. scalefactor for width correction by spacing between column is not back to normal+ again. At most two columns of a table may be wraped, the fontssize of the table is reduced + otherwise now. Tables with contain nested tables are now always typeset in landscape mode +Version 7.17+ * src+ avoid problems with limits on the number of handels on stderr and stdout streams+ of subprocesses.+Version 7.16+ * src+ some templates for german wikibooks have been added+ the maximum number of treads has been limited to 200 in order to+ avoid problems with limits on the number of file and socket handles.+Version 7.15+ * src+ on linux the maximum length of a line in a latex document has been increased+ chars outside 16 bit unicode range are using font for space character+ test on 2700 features articles on the english wikipedia resulted in only one + failiure namely Chess+Version 7.14+ * src+ server properly reads subprocess pipes now, so the don't overrun anymore+ varwidth environments now properly closed when doing latex runs to calculate+ optimized column width+ stub for selftesting added but no functionally implemented yet +Version 7.13+ * src+ Webserver now does time out if processing takes to long+ Article on New Jouralsim compiles aganin+ This solved by packing table cell in varwidth minipages for column width calculation+ html fallback. If a server does not seem to be running mediawiki html is processes as fallback+Version 7.12+ * src+ Web server got a professionally looking web interface new+ Formulas on the German Wikipedia work again+Version 7.11+ * src+ progress strings are now printed to allow precise progress indication+Version 7.10 + * src+ alternative LaTeX headers can be supplied by the user+Version 7.5+ * src+ books can now have an index+Version 7.4+ * src+ -c command line option also on Windows+ use of more that one cpus core by runtime system enabled+Version 7.3+ * src+ Using multiple OS threads. Speedup by a faktor of two due to IO parallelism+Version 7.2+ * src+ images and list of figures works for even more non wikimedia wikis+ fonts now switched during latex run so full 16 bit unicode support on debian included+ server added+Version 7.1+ * src+ mediawiki urls in default configuration, that is with index.php in between work+ relative pathnames for -c command line option work+ gui added+ table of contents is only procuded once per document+Version 6.6+ * src+ Added command line option for using megafont ttf files if requested+Version 6.5+ * Makefile:+ A lot of improvements int the building process. Should be easily+ packageable now.+ Using 'install' instead of 'cp' to make sure file access is right.+ Generate man page.++ * mediawiki2latex.1:+ Completed man page.++ * INSTALL:+ Listed most dependencies. Needs to be polished.++ * .:+ Removed useless files and folders.+ Removed backup files.++Version 6.4+ ...
document/headers/commands.tex view
@@ -4,22 +4,49 @@ \DefineVerbatimEnvironment{Highlighting}{Verbatim}{commandchars=\\\{\}} % Add ',fontsize=\small' for more characters per line \newenvironment{Shaded}{\begin{scriptsize}}{\end{scriptsize}}+\newcommand{\VerbBar}{|}+\newcommand{\VERB}{\Verb[commandchars=\\\{\}]}+\DefineVerbatimEnvironment{Highlighting}{Verbatim}{commandchars=\\\{\}}+% Add ',fontsize=\small' for more characters per line \newcommand{\KeywordTok}[1]{\textbf{{#1}}} \newcommand{\DataTypeTok}[1]{\underline{{#1}}} \newcommand{\DecValTok}[1]{{#1}} \newcommand{\BaseNTok}[1]{{#1}} \newcommand{\FloatTok}[1]{{#1}}+\newcommand{\ConstantTok}[1]{{#1}} \newcommand{\CharTok}[1]{{#1}}+\newcommand{\SpecialCharTok}[1]{{#1}} \newcommand{\StringTok}[1]{{#1}}+\newcommand{\VerbatimStringTok}[1]{{#1}}+\newcommand{\SpecialStringTok}[1]{{#1}}+\newcommand{\ImportTok}[1]{{#1}} \newcommand{\CommentTok}[1]{\textit{{#1}}}+\newcommand{\DocumentationTok}[1]{\textit{{#1}}}+\newcommand{\AnnotationTok}[1]{\textit{{#1}}}+\newcommand{\CommentVarTok}[1]{\textit{{#1}}} \newcommand{\OtherTok}[1]{{#1}}-\newcommand{\AlertTok}[1]{\textbf{{#1}}} \newcommand{\FunctionTok}[1]{{#1}}+\newcommand{\VariableTok}[1]{{#1}}+\newcommand{\ControlFlowTok}[1]{\textbf{{#1}}}+\newcommand{\OperatorTok}[1]{{#1}}+\newcommand{\BuiltInTok}[1]{{#1}}+\newcommand{\ExtensionTok}[1]{{#1}}+\newcommand{\PreprocessorTok}[1]{\textbf{{#1}}}+\newcommand{\AttributeTok}[1]{{#1}} \newcommand{\RegionMarkerTok}[1]{{#1}}+\newcommand{\InformationTok}[1]{\textit{{#1}}}+\newcommand{\WarningTok}[1]{\textit{{#1}}}+\newcommand{\AlertTok}[1]{\textbf{{#1}}} \newcommand{\ErrorTok}[1]{\textbf{{#1}}} \newcommand{\NormalTok}[1]{{#1}}+++++ \newcommand{\myfigurewithoutcaption}[1]{{\bfseries \myfigurebabel{ }#1}} \newcommand{\myfigurewithcaption}[2]{{\bfseries \myfigurebabel{ }#1{\quad}}#2}+\renewcommand{\iff}{\Longleftrightarrow} % Definition der Fussnoten % ------------------------
document/headers/defaultcolors.tex view
@@ -196,6 +196,8 @@ \definecolor{olive}{rgb}{0.501960784314,0.501960784314,0.0} \definecolor{OliveDrab}{rgb}{0.419607843137,0.556862745098,0.137254901961} \definecolor{olivedrab}{rgb}{0.419607843137,0.556862745098,0.137254901961}+\definecolor{OliveGreen}{rgb}{0.0,0.6,0.0}+\definecolor{olivegreen}{rgb}{0.0,0.6,0.0} \definecolor{Orange}{rgb}{1.0,0.647058823529,0.0} \definecolor{orange}{rgb}{1.0,0.647058823529,0.0} \definecolor{OrangeRed}{rgb}{1.0,0.270588235294,0.0}
document/headers/hyphenation.tex view
@@ -31,6 +31,7 @@ \hyphenation{Reich} \hyphenation{Trier} \hyphenation{Butter-worth}+\hyphenation{Agar-kulturen} \hyphenation{Rausch-unter-dr\"uckung}
document/headers/options.tex view
@@ -106,6 +106,7 @@ \renewcommand{\mymaintitle}[1]{} \renewcommand{\myauthor}[1]{} + \newenvironment{myshaded}{% \def\FrameCommand{ \hskip-2pt \fboxsep=\FrameSep \colorbox{shadecolor}}% \MakeFramed {\advance\hsize-\width \FrameRestore}}%
document/headers/packages2.tex view
@@ -54,4 +54,5 @@ \usepackage{tocstyle} \usepackage{amsthm} \usepackage{index}+\usepackage{scalefnt} \makeindex
document/headers/templates.tex view
@@ -39,9 +39,29 @@ Unless otherwise noted, #4 used in this book have their own copyright, may use different licenses than the one used here, and were not created by the above authors. The authors, contributors, and licenses used should be acknowledged separately.} } +\newcommand{\NFFallunterscheidung}[8]{+{\bfseries Fall 1:} #1 \\+#2 \\+{\bfseries Fall 2:} #3 \\+#4 \\+{\bfseries Fall 3:} #5 \\+#6 \\+{\bfseries Fall 4:} #7 \\+#8 \\+} +\newcommand{\NFAufgabe}[2]{+{\bfseries Aufgabe:}\\+#1 \\+{\bfseries Lösung:}\\+#2 \\+}+ \newcommand{\tlTemplate}[1]{{\{\{{\ttfamily #1}\}\}}} +\newcommand{\LaTeXQuelleLink}[3]{(#1 #2 #3)}++ \newcommand{\matrixdimTemplate}[1]{ \definecolor{shadecolor}{gray}{0.9} \begin{myshaded}@@ -92,6 +112,8 @@ \newcommand{\LaTeXNullTemplate}[1]{}+\newcommand{\LaTeXEquals}[1]{=}+ \newcommand{\LatexSymbol}[1]{\LaTeX} \newcommand{\LaTeXDoubleBoxTemplate}[2]{@@ -103,7 +125,21 @@ } +\newcommand{\NFHinweis}[1]{ +\begin{minipage}{\linewidth}\definecolor{shadecolor}{gray}{0.9}\begin{myshaded}{+\begin{flushleft}+\begin{Large}+{\Huge \textcircled{\LARGE !}} \ Hinweis+\end{Large}+\end{flushleft}}+\medskip+#1+\end{myshaded}+\end{minipage}++}+ \newcommand{\LaTeXSimpleBoxTemplate}[2]{ {\bfseries #1} \\ #2@@ -122,7 +158,40 @@ } +\newcommand{\LaTeXDoubleBoxOpenTemplate}[2]{ +\definecolor{shadecolor}{gray}{0.9}\begin{myshaded}{\bfseries #1} \\+#2+\end{myshaded}++}++\newcommand{\Loesungsweg}[2]{++\definecolor{shadecolor}{gray}{0.9}\begin{myshaded}{\bfseries Wie kommt man auf den Beweis? #1} \\+#2+\end{myshaded}++}+++\newcommand{\LaTeXInduktion}[6]{++\definecolor{shadecolor}{gray}{0.9}\begin{myshaded}{\bfseries Aussageform, deren Allgemeingültigkeit für #1 bewiesen werden soll:} \\+#2+{\newline \bfseries 1. Induktionsanfang}+#3+{\newline \bfseries 2. Induktionsschritt}+{\newline \bfseries 2a. Induktionsvoraussetzung}+#4+{\newline \bfseries 2b. Induktionsbehauptung}+#5+{\newline \bfseries 2c. Beweis des Induktionsschritts}+#6+\end{myshaded}++}+ \newcommand{\LaTeXLatinExcerciseTemplate}[3]{ \definecolor{shadecolor}{gray}{0.9}\begin{myshaded}{\bfseries Excercise: #1} \\@@ -196,6 +265,7 @@ \newcommand{\LaTeXIdentityTemplate}[1]{#1 }+\newcommand{\Doppellizenz}[1]{Dieser Text ist sowohl unter GFDL als auch CC BY-SA 3.0 lizenziert. Wenn der Text unter CC BY-SA 3.0 genutzt wird, kann entsprechend Abschnitt 4b als Autor „Wikibooks“ genannt werden.} \newcommand{\AdaRM}[3]{\myfnhref{http://www.adaic.org/resources/add_content/standards/05rm/html/RM-#1-#2.html}{#1.#2 #3}} @@ -251,8 +321,12 @@ \newcommand{\AdaPragma}[1]{\LaTeXTTBF{pragma} } +\newcommand{\yes}[1]{yes}+\newcommand{\no}[1]{no}+\newcommand{\BlenderRepo}[1]{\myfnhef{https://developer.blender.org/diffusion/B/browse/master/#1}{#1}} \newcommand{\TychoBrahe}[1]{Tycho Brahe}+\newcommand{\BlenderAlignedView}[1]{This tutorial relies on objects being created so that they are aligned to the view that you’re looking through. Versions 2.48 and above have changed the way this works. Visit \myfnhref{https://en.wikibooks.org/wiki/Blender_3D:_Noob_to_Pro/Aligned_to_view_issue}{Aligned} to view issue to understand the settings that need to be changed.} \newcommand{\LaTeXPlainBoxTemplate}[1]{ \begin{minipage}{\linewidth}\definecolor{shadecolor}{gray}{0.9}\begin{myshaded} @@ -502,6 +576,7 @@ \newcommand{\LaTeXTextTemplate}[1]{\LaTeXDoubleBoxTemplate{}{#1}} \newcommand{\LaTeXExampleTemplate}[1]{\LaTeXDoubleBoxTemplate{Example:}{#1}}+\newcommand{\HaskellExampleTemplate}[2]{\LaTeXDoubleBoxTemplate{Example: #1}{#2}} \newcommand{\LaTeXexampleTemplate}[1]{\LaTeXDoubleBoxTemplate{Example:}{#1}} @@ -513,8 +588,17 @@ \newcommand{\LaTeXbodynoteTemplate}[1]{\LaTeXDoubleBoxTemplate{Note:}{#1}} +\newcommand{\DarcsPatchProperty}[1]{\LaTeXDoubleBoxTemplate{Patch property:}{#1}}+++ \newcommand{\LaTeXecebcite}[1]{\textsuperscript{[#1]}} +\newcommand{\LaTeXmainpage}[1]{{\itshape Main Page: #1}}+\newcommand{\LaTeXAsof}[1]{As of #1}+\newcommand{\LaTeXasof}[1]{as of #1}++ \newcommand{\LaTeXAPDIPpreface}[1]{ Roberto R. Romulo \newline Chairman (2000-2002) \newline@@ -632,6 +716,7 @@ \newcommand{\ChemTemplate}[9]{\texttt{ #1#2#3#4#5#6#7#8#9}} +\newcommand{\QED}[1]{\square} \newcommand{\WaningTemplate}[1]{ \begin{TemplateInfo}{\danger}{Warning}@@ -697,6 +782,11 @@ \newcommand{\NFDef}[2]{\begin{mydef}#1\end{mydef}#2} \newcommand{\NFBeweis}[2]{\begin{beweis}#1\end{beweis}#2}++\newcommand{\NFBeweisschritt}[2]{{\bfseries Beweisschritt} #1 \\ #2}++\newcommand{\Smiley}[1]{$\ddot\smile$}+ \newcommand{\NFBeispiel}[2]{\begin{beweis}#1\end{beweis}#2}
latex/my-head.tex view
@@ -20,10 +20,11 @@ \usepackage{xltxtra} \usepackage{fontspec} -\setmainfont[Path=/usr/share/fonts/truetype/cmu/,UprightFont=cmunrm.ttf,BoldFont=cmunbx.ttf,ItalicFont=cmunti.ttf,BoldItalicFont=cmunbi.ttf]{cmunbx.ttf}-\setmonofont[Path=/usr/share/fonts/truetype/cmu/,UprightFont=cmuntt.ttf,BoldFont=cmuntb.ttf,ItalicFont=cmunit.ttf,BoldItalicFont=cmuntx.ttf]{cmunbx.ttf}+\setmainfont[Path=/usr/share/fonts/truetype/cmu/,UprightFont=cmunrm,BoldFont=cmunbx,ItalicFont=cmunti,BoldItalicFont=cmunbi]{cmunbx.ttf}+\setmonofont[Path=/usr/share/fonts/truetype/cmu/,UprightFont=cmuntt,BoldFont=cmuntb,ItalicFont=cmunit,BoldItalicFont=cmuntx]{cmunbx.ttf} \begin{document}+\allowdisplaybreaks \usetocstyle{standard} \raggedbottom \thispagestyle{empty}
latex/my-tabhead.tex view
@@ -19,7 +19,7 @@ \usepackage{type1ec} \usepackage{xltxtra} \usepackage{fontspec}-+\usepackage{varwidth} \setmainfont[ UprightFont=FreeSerif, BoldFont=FreeSerifBold,
latex/templates.user view
@@ -6,19 +6,49 @@ ["Mathe f\252r Nicht-Freaks: Vorlage:Navigation Oben","LaTeXNullTemplate"], ["Mathe f\252r Nicht-Freaks: Vorlage:Navigation Unten","LaTeXNullTemplate"], ["Aufgabensammlung: Vorlage:Infobox","LaTeXNullTemplate"],+["Druckversion","LaTeXNullTemplate"],+["Vorlage:Auszeichnung BdM","LaTeXNullTemplate"],+["TOCright","LaTeXNullTemplate"],+["Hinweis PDF","LaTeXNullTemplate"],+["Referenzen Hinweis","LaTeXNullTemplate"],+["","LaTeXNullTemplate"],+["msg:EngTherm","LaTeXNullTemplate"],+["msg:stub","LaTeXNullTemplate"],+["EngTherm","LaTeXNullTemplate"],+["book title","LaTeXNullTemplate"],+["Clr","LaTeXNullTemplate"],+["Data Structures/ChapNav","LaTeXNullTemplate"],+["yes","yes"],+["no","no"],+["B3D:N2P/RepoMain","BlenderRepo","1"],+["Wikifizieren","LaTeXNullTemplate"],+["#ifeq:{{{include","LaTeXNullTemplate"],+["Sammlung","LaTeXNullTemplate"],+["Wie_mein_Buch_auf_die_Welt_kommt/_Vorlage:Nav_ZVo","LaTeXNullTemplate"], ["Mathe f\252r Nicht-Freaks: Vorlage:Klapptext","LaTeXDoubleBoxOpenTemplate","kopf","inhalt"],+["Aufgabensammlung: Vorlage:Klapptext","LaTeXDoubleBoxOpenTemplate","kopf","inhalt"],+["DS:ADT","LaTeXDoubleBoxOpenTemplate","1","2"],+["Mathe f\252r Nicht-Freaks: Vorlage:Beweisschritt","NFBeweisschritt","ziel","beweisschritt"], ["Mathe f\252r Nicht-Freaks: Vorlage:Beweis","NFBeweis","titel","beweis"], ["Mathe f\252r Nicht-Freaks: Vorlage:Definition","NFDef","titel","definition"],+["mathe f\252r Nicht-Freaks: Vorlage:Definition","NFDef","titel","definition"], ["Mathe f\252r Nicht-Freaks: Vorlage:Satz","NFSatz","titel","satz"], ["Mathe f\252r Nicht-Freaks: Vorlage:Beispiel","NFBeispiel","titel","beispiel"],-["Mathe f\252r Nicht-Freaks: Vorlage:Hinweis","Hinweis","1"],+["Mathe f\252r Nicht-Freaks: Vorlage:Hinweis","NFHinweis","1"], ["Mathe f\252r Nicht-Freaks: Vorlage:Warnung","WarnungTemplate","1"],+["Mathe f\252r Nicht-Freaks: Vorlage:Aufgabe","NFAufgabe","aufgabe","l\246sung"],+["Mathe f\252r Nicht-Freaks: Vorlage:Fallunterscheidung","NFFallunterscheidung","fall1","fall1-beweis","fall2","fall2-beweis","fall3","fall3-beweis","fall4","fall4-beweis"], ["Mathe f\252r Nicht-Freaks: Vorlage:Vertiefung","NFVertiefung"],+["Smiley","Smiley"], ["Hidden end","LaTeXNullTemplate"],+["Versteckt","LaTeXNullTemplate"],+["Doppellizenz CC by-sa Wikibooks","Doppellizenz"], ["TJa","LaTeXJa"], ["TNein","LaTeXNein"], ["overline","myoverline","1"],+["Overline","myoverline","1"], ["Java/Hidden begin","LaTeXNullTemplate"],+["Nicht l\246schen","LaTeXNullTemplate"], ["Blender3D:_Vorlage:clr","LaTeXNullTemplate"], ["Blender3D:_Vorlage:Nav_ZVu","LaTeXNullTemplate"], ["Blender3D:_Vorlage:Nav_ZVu","LaTeXNullTemplate"],@@ -44,6 +74,7 @@ ["Control Systems Page","LaTeXNullTemplate"], ["Control Systems Page","LaTeXNullTemplate"], ["MATLAB CMD","matlabTemplate","1"],+["=","LaTeXEquals"], ["Control Systems/Matrix Dim","matrixdimTemplate"], ["Control Systems/Nav","LaTeXNullTemplate"], ["Python Programming/Navigation","LaTeXNullTemplate"],@@ -54,13 +85,16 @@ ["move","LaTeXNullTemplate"], ["LaTeX/Bottom","LaTeXNullTemplate"], ["C Programming","LaTeXNullTemplate"],+["Mathe f\252r Nicht-Freaks: Vorlage:L\246sungsweg","Loesungsweg","titel","l\246sungsweg"], ["Special Relativity","LaTeXNullTemplate"],+["Formel","LaTeXIdentityTemplate","1"], ["C Programming/Navigation End","LaTeXNullTemplate"], ["Vorlage:Referenzen Start","LaTeXNullTemplate"], ["Vorlage:Referenzen Ende","LaTeXNullTemplate"], ["Vorlage:Referenzen Eintrag","VorlageReferenzenEintrag","1","2","3"], ["Referenzen Start","LaTeXNullTemplate"], ["Referenzen Ende","LaTeXNullTemplate"],+["Symbol","LaTeXIdentityTemplate","1"], ["Referenzen Eintrag","VorlageReferenzenEintrag","1","2","3"], ["Soziologische Klassiker/ Vorlage:Unvollst\228ndig","LaTeXNullTemplate"], ["Soziologische Klassiker/ Vorlage:AbsatzGel\246scht","LaTeXNullTemplate"],@@ -68,6 +102,7 @@ ["Creator:Tycho Brahe","TychoBrahe"], ["Belege","LaTeXNullTemplate"], ["DISPLAYTITLE","LaTeXNullTemplate"],+["Aufgabensammlung: Vorlage:Vollst\228ndige Induktion","LaTeXInduktion","erfuellungsmenge","aussageform","induktionsanfang","induktionsvoraussetzung","induktionsbehauptung","beweis_induktionsschritt"], ["B3D:N2P/NAV","LaTeXNullTemplate"], ["displaytitle","LaTeXNullTemplate"], ["Template:B3D:N2P/Prerelease","LaTeXNullTemplate"],@@ -99,6 +134,7 @@ ["CompactTOC8","LaTeXNullTemplate"], ["LaTeX/Parameter","LaTeXTT","1"], ["B3D:N2P/FirstUse","LaTeXBF","1"],+["subject definition","LaTeXBF","1"], ["Tip","LaTeXTipTemplate","1"], ["LaTeX/Package","LaTeXTT","1"], ["LaTeX/Environment","LaTeXTT","1"],@@ -112,14 +148,18 @@ ["Blue","MyBlau","1"], ["mergeto","LaTeXNullTemplate"], ["Modulesplit","LaTeXNullTemplate"],+["blender3d_Aligned_to_view_issue","BlenderAlignedView"], ["Blender3D:_Vorlage:Nav_ZVo","LaTeXNullTemplate"], ["TOC right","LaTeXNullTemplate"],+["Navigation","LaTeXNullTemplate"], ["Blender3D:_Vorlage:Tip","LaTeXTipTemplate","1"], ["Blender3D:_Vorlage:Version","BlenderVersion","1"], ["Blender3D: Vorlage:Version","BlenderVersion","1"], ["Blender3D:_Vorlage:KEY","keystroke","1"],+["B3D:N2P/Key","keystroke","1"], ["keypress","keystroke","1"], ["Solution","LaTeXDoubleBoxOpenTemplate","title","text"],+["Klappbox","LaTeXDoubleBoxOpenTemplate","1","2"], ["SVG/ Vorlage/ Versionen","SVGVersions","batik","opera","firefox","konqueror","safari","chrome","ie","rsvg"], ["Java/Illustration","JavaIllustration","number","caption","image"], ["Blender3D:_Vorlage:Difficulty","WaningTemplate","1"],@@ -132,6 +172,8 @@ ["Blender3D:_Vorlage:Version_sH","BlenderVersion","1"], ["Blender3D:_Vorlage:Version_Archiv","BlenderVersion","1"], ["Blender3D:_Vorlage:Note2","LaTeXDoubleBoxTemplate","1","2"],+["Code:Basic","LaTeXDoubleBoxTemplate","1","2"],+["code:Basic","LaTeXDoubleBoxTemplate","1","2"], ["GLSL Programming Expandable Box","LaTeXDoubleBoxOpenTemplate","1","2"], ["Blender3D:_Vorlage:Nav_Anfang_o","LaTeXNullTemplate"], ["Blender3D: Vorlage:Nav_Anfang_o","LaTeXNullTemplate"],@@ -196,6 +238,7 @@ ["Print version","LaTeXNullTemplate"], ["alphabetical","LaTeXNullTemplate"], ["navigate","LaTeXNullTemplate"],+["Navigate","LaTeXNullTemplate"], ["Newpage","LaTeXNullTemplate"], ["Subjects","LaTeXNullTemplate"], ["C sharp/Keywords","LaTeXNullTemplate"],@@ -253,8 +296,6 @@ ["Ada/2005/RM1","ADARMONE","1","2"], ["Ada/95/R1","AdaNineFiveR","1","2","part"], ["Ada/95/R2","AdaNineFiveRTwo","1","2","3","part"],-- ["Ada/2005/Cite RM","AdaRMCiteFive","1","2","3","title","par","id","quote"], ["Ada/Sourceforge","ADAFile","1"], ["Algorithms/Sample","ADASample","1"],@@ -271,6 +312,7 @@ ["Print chapter heading","chapter","1"], ["Print unit page","LaTeXNullTemplate"], ["Python unter Linux: Vorlagen:VorlageDetails","LaTeXPythonUnterLinuxVorlagenVorlageDetailsTemplate","1"],+["Python_unter_Linux: Vorlagen:VorlageDetails","LaTeXPythonUnterLinuxVorlagenVorlageDetailsTemplate","1"], ["msg:GeneralChemTOC","LaTeXNullTemplate"], ["GeneralChemTOC","LaTeXNullTemplate"], ["citation needed","LaTeXNullTemplate"],@@ -346,12 +388,17 @@ ["reflist","LaTeXNullTemplate"], ["Auto category","LaTeXNullTemplate"], ["FULLCHAPTERNAME","LaTeXNullTemplate"],+["Quelle-Link","LaTeXQuelleLink","1","text","name"],+["Quelle-Beleg","LaTeXNullTemplate"], ["Haskell/Navigation","LaTeXNullTemplate"], ["sectstub","LaTeXNullTemplate"], ["Haskell navigation","LaTeXNullTemplate"], ["Haskell import Haskell wiki","LaTeXNullTemplate"], ["Haskell stub","LaTeXNullTemplate"], ["Haskell minitoc","LaTeXNullTemplate"],+["Simple Page Navigation","LaTeXNullTemplate"],+["refbegin","LaTeXNullTemplate"],+["refend","LaTeXNullTemplate"], ["Haskell/Interlanguage","LaTeXNullTemplate"], ["Haskell/NotesSection","LaTeXNullTemplate"], ["SUBPAGENAME","LaTeXNullTemplate"],@@ -360,6 +407,7 @@ ["Fortran:Vorlage: NavigationMain" ,"LaTeXNullTemplate"], ["Vorlage:Navigationsleiste Alphabet"], ["Info","LaTexInfoTemplateOne","1"],+["Ambox","LaTexInfoTemplateOne","text"], ["SideBox","LaTeXPlainBoxTemplate","1"], ["Calculus/Def","LaTeXDoubleBoxTemplate","title","text"], ["DropBox","LaTeXDoubleBoxTemplate","1","2"],@@ -379,6 +427,7 @@ ["Anorganische Chemie f\195\188r Sch\195\188ler: Vorlage: Merksatz", "LaTeXAnorganischeChemiefuerSchuelerVorlageMerksatzTemplate", "Text"], ["Text", "LaTeXTextTemplate", "1"], ["Example", "LaTeXExampleTemplate", "1"],+["HaskellExample", "HaskellExampleTemplate", "1","2"], ["example", "LaTeXexampleTemplate", "1"], ["PTPBox", "LaTeXPTPBoxTemplate", "1"], ["NOTE", "LaTeXNOTETemplate", "1", "note"],@@ -387,6 +436,7 @@ ["Body note", "LaTeXbodynoteTemplate", "1"], ["cquote", "LaTeXcquoteTemplate", "1"], ["Cquote", "LaTeXCquoteTemplate", "1"],+["Python Programming/Note", "LaTeXSideNoteTemplate", "1"], ["Side note", "LaTeXSideNoteTemplate", "1"], ["side note", "LaTeXsideNoteTemplate", "1"], ["Exercises", "LaTeXExercisesTemplate", "1"],@@ -441,18 +491,46 @@ ["Anorganische Chemie f\252r Sch\252ler: Vorlage: S","ACFSVorlageS"], ["Anorganische Chemie f\195\188r Sch\195\188ler: Vorlage: S","ACFSVorlageS"], ["Taste","keystroke","1"],+["QED","QED"], ["Register","fbox","1"], ["\220bung4 L\246sung","TemplateHeaderSolutionUebung","1","2"], ["\195\156bung4 L\195\182sung","TemplateHeaderSolutionUebung","1","2"], ["\220bung4","TemplateHeaderExerciseUebung","1","2"], ["\195\156bung4","TemplateHeaderExerciseUebung","1","2"], ["Yellow Warning","WaningTemplate","1"],+["XWarning","WaningTemplate","1"], ["Warnung","WarnungTemplateTemplate","1"], ["element cell-p","LaTeXIdentityTemplate","3"], ["Ada/dl","LaTeXIdentityTemplate","1"], ["Ada/delimiter","LaTeXIdentityTemplate","1"], ["Ada/Integer subtypes diagram","LaTeXNullTemplate"],+["Using Wikibooks/Page","LaTeXNullTemplate"],+["Intro to LIS","LaTeXNullTemplate"],+["#invoke:Mathe für Nicht-Freaks/Seite","LaTeXNullTemplate"],+["Aufgabensammlung: Vorlage:Symbol","LaTeXNullTemplate"],+["intro to LIS","LaTeXNullTemplate"], ["Windows Programming Stub","LaTeXNullTemplate"],+["Astronomy/Header","LaTeXNullTemplate"],+["Astronomy/Footer","LaTeXNullTemplate"],+["Find Employment Page","LaTeXNullTemplate"],+["Find Employment","LaTeXNullTemplate"],+["How to Pass a Course","LaTeXNullTemplate"],+["rename","LaTeXNullTemplate"],+["merge","LaTeXNullTemplate"],+["split","LaTeXNullTemplate"],+["nowrap begin","LaTeXNullTemplate"],+["nowrap end","LaTeXNullTemplate"],+["Darcs patch property","DarcsPatchProperty","1"],+["Auto navigation","LaTeXNullTemplate"],+["Microprocessor Design","LaTeXNullTemplate"],+["GFDL","LaTeXNullTemplate"],+["Electronics","LaTeXNullTemplate"],+["General Mechanics","LaTeXNullTemplate"],+["ambox","LaTeXNullTemplate"],+["dn","LaTeXNullTemplate"],+["Main","LaTeXmainpage","1"],+["As of","LaTeXAsof","1"],+["as of","LaTeXasof","1"], ["E-Commerce and E-Business","LaTeXNullTemplate"], ["Unreferenced","LaTeXNullTemplate"], ["VBClassicNav1","LaTeXNullTemplate"],
mediawiki2latex.cabal view
@@ -1,5 +1,5 @@ Name: mediawiki2latex-Version: 7.9.0.1+Version: 7.33 License: GPL License-File: LICENSE Author: Dirk Hünniger <dirk.hunniger@googlemail.com>@@ -8,7 +8,7 @@ Category: Text Synopsis: Convert MediaWiki text to LaTeX Description:- mediawiki2latex converts MediaWiki markup to LaTeX and PDF.+ mediawiki2latex converts MediaWiki markup to LaTeX, PDF, EPUB and ODT. So it provides and export from MediaWiki to LaTeX. It works with any project running MediaWiki, especially Wikipedia and Wikibooks. Please note, that the program requieres certain run time dependencies. Those@@ -89,6 +89,7 @@ src/babel/ur src/babel/vi src/babel/yi+ src/babel/zh document/headers/commands.tex document/headers/defaultcolors.tex document/headers/formattings.tex@@ -102,6 +103,7 @@ document/headers/templates-dirk.tex document/headers/templates.tex document/headers/unicodes.tex+ ChangeLog Source-Repository head Type: git@@ -111,9 +113,12 @@ Executable mediawiki2latex Build-Depends: directory-tree,+ network-uri, bytestring, process, http-conduit,+ http-client,+ http-types, bytestring >= 0.10, temporary >1.0, file-embed,@@ -136,6 +141,12 @@ text, happstack-server, mtl,+ blaze-markup,+ time,+ zip-archive,+ deepseq,+ hashable,+ strict, network >= 2.3.0.13 Other-Modules:@@ -143,19 +154,16 @@ Babel BaseFont Compiler- Contributors- Font FontTool GetImages Hex+ HtmlRenderer ImperativeState- Join LatexRenderer Licenses Load Logger MagicStrings- MakeChess MediaWikiParser MediaWikiParseTree MegaFont@@ -166,12 +174,11 @@ Static TableHelper Tools- TouchJPEG UrlAnalyse WikiHelper WikiLinkHelper - GHC-Options: -Wall -O2 -rtsopts "-with-rtsopts=-K100M -N" -threaded + GHC-Options: -Wall -fno-warn-orphans -rtsopts "-with-rtsopts=-K1000M -N" -threaded -optl-Wl,-z,relro -optl-Wl,-z,now Hs-Source-Dirs: src Main-Is: mediawiki2latex.hs
src/All.hs view
@@ -1,4 +1,4 @@-+{-| imperative part of the programm. The outer flow of the programm is controlled here -} module All where import System.Directory.Tree import Data.String.HT@@ -9,8 +9,6 @@ import Load import Compiler import GetImages-import MakeChess-import Join import Control.Monad.State hiding (join) import Tools import Data.ByteString@@ -22,35 +20,49 @@ import System.Info import System.Process hiding (cwd) import Static+import Babel import Data.List.Split import MagicStrings import Codec.Binary.UTF8.String-import Data.Map hiding (map)-import Data.List.HT (dropWhileRev)+import Data.Map.Strict hiding (map, take, drop) import Data.ByteString.UTF8 (toString) import Data.List import Data.Maybe import Data.Char import MediaWikiParseTree+import qualified Data.Map.Strict as Map hiding (take, drop) import MediaWikiParser import SimpleContributors import UrlAnalyse import Network.URL import System.FilePath-import Control.Concurrent.MVar-import Parallel- +import Control.Concurrent.MVar ()+import Data.Hashable+import Hex+import Data.IORef+import System.IO+import Codec.Archive.Zip+import Data.ByteString.Lazy (toStrict)+import System.Exit+import System.IO.Error++{-| takes a filename as input parameter and returns the so called normalized extension for it. This is and extension classifying the type of the file while used in this program. Its not necessarily the real extension of the filename. For example .jpeg images will be converted to jpg and so on. -}+ getExtension :: String -> String getExtension s = normalizeExtension2 (map toLower (reverse . (takeWhile (/= '.')) . reverse $ s))- ++{-| returns that name of image magick convert command on the current operating system. It takes the path from which mediawiki2latex was started as input parameter. On Windows convert.exe has to reside in a path relative to it for this to work. On linux it does not matter -}+ getConvert :: FilePath -> String getConvert p = if os == "linux" then convert else (getPathPrefix p) ++ convert where convert = if os == "linux" then "convert " else "convert.exe "- ++{-| generates the information for the titlepage. It takes the result of the wiki text compilation (CompileResult) as first input parameter and the FullWikiUrl to the article as second parameter. It title information is found in the CompileResult it is used, otherise it is generated from the FullWikiUrl -}+ makeTitle :: CompileResult -> FullWikiUrl -> [Char] makeTitle result fu = theTitle where theTitle@@ -63,15 +75,26 @@ = "\\title{" ++ (concat (map (chartrans) ((removePrintVersion (lemma fu))))) ++ "}\n"- ++makeTitle2 :: CompileResult -> FullWikiUrl -> [Char]+makeTitle2 result fu = theTitle+ where theTitle+ = if (Compiler.title result) == "" then tit else+ (Compiler.title result)+ tit = (concat (map (chartrans) ((removePrintVersion (lemma fu)))))++{-| returns the prefix of the path where addional needed software resides depending on the operation system -}+ getPathPrefix :: FilePath -> String getPathPrefix p = if os == "linux" then "" else (p ++ "..\\lib\\")- ++{-| applied the necessary image processing to a file so that it can be included in a latex document and does not take too much discspace. It takes the path form which mediawiki2latex was started as first input parameter. It takes filename with its exension stiped as second input parameter. It takes the normalized exension of the file as third parameter (see also function getExtension in this module). It takes the maximum resolution that images should have as fourth parameter. It takes the imagenumbers of the images residing in image galleries in the wiki source text as fifth parameter (those images are given a lower absolute with in cm in the pdf document and thus can be dithered to a loweder absolute with in pixels). It takes the image number of the current image as sixth parameter. -}+ runFileMods :: FilePath -> String -> String -> Integer -> [Integer] -> Integer -> String -> IO ()-runFileMods p filenamebase extension theResolution gals imageNumber+runFileMods p filenamebase extension theResolution gals imgNumber pathname = case extension of ('s' : ('v' : ('g' : _))) -> do _ <- system@@ -116,7 +139,7 @@ = system ((getConvert p) ++ fn ++ " -background white -flatten " ++ fn) pngfilename = filenamebase ++ "." ++ "png"- + dither :: String -> IO () dither fn = do _ <- system@@ -138,7 +161,7 @@ [(ii, _)] -> do runDither fn (if- imageNumber+ imgNumber `elem` gals then@@ -150,7 +173,7 @@ _ -> return () _ -> return () _ -> return ()- + runDither :: String -> Integer -> Integer -> IO () runDither fn newSize oldSize = if newSize < oldSize then@@ -161,68 +184,84 @@ else return () textWidth = 10.5 galleryImageWidth = 5.0- + centimetersPerInch :: Double centimetersPerInch = 2.54- + galleryWidth :: Integer galleryWidth = round ((fromIntegral theResolution) * galleryImageWidth / centimetersPerInch)- + imageWidth :: Integer imageWidth = round ((fromIntegral theResolution) * textWidth / centimetersPerInch)- ++{-| function to write the image files into the temporary directory and modify the files for use in a LaTeX document. It takes the pathname of temporary image download directory as first input parameter. Please not the the temporary image download directory is always different from the temporary directory. It takes the pathname of the directory in which mediawiki2latex was stated as second input parameter. It takes the name of the temporary directory as third input parameter. It takes the result of the image downloading process as fourth input parameter. This structure has a Maybe monad as outer type since the image download may fail. Inside is a 3 element tuple. The first one is the filename of the image on the wiki. The second one is the number under which the image was stored in the temporary image download directory. The third one is a list of possible urls where the image may be found on the wiki. It takes maximum resolution that images should have as fifth parameter. It takes the list of images number of images residing in galleries as sixth input parameter. -}+ writeFiles :: FilePath -> FilePath ->- String ->- [Maybe (String, Integer, [String])] ->- Integer -> [Integer] -> IO ()+ String -> [Maybe ImageInfo] -> Integer -> [Integer] -> IO () writeFiles dir p pathname theImages theResolution gals = mapM_ go (Prelude.zip ([1 ..] :: [Integer]) theImages)- where go (i, Just (n, ii, _))+ where go (i, Just x) = do let filenamebase = (pathname ++ (show i))- let filename = filenamebase ++ "." ++ (getExtension n)- filecontent <- Data.ByteString.readFile (dir </> (show ii))+ let filename+ = filenamebase ++ "." ++ (getExtension (wikiFilename x))+ filecontent <- Data.ByteString.readFile+ (dir </> (show (imageNumber x))) Data.ByteString.writeFile filename filecontent- runFileMods p filenamebase (getExtension n) theResolution gals i+ runFileMods p filenamebase (getExtension (wikiFilename x))+ theResolution+ gals+ i pathname go _ = return ()- -makeBabel :: Maybe String -> [Char] -> String-makeBabel b x- = case Data.Map.lookup (fromMaybe xx b) m of- Just v -> decode . unpack $ v- _ -> case Data.Map.lookup "en" m of- Just w -> decode . unpack $ w- _ -> ""- where m = fromList babelFiles- xx- = case splitOn "." x of- (z : _) -> z- _ -> "en"- -data LatexConfig = LatexConfig{figures ::- [Maybe (String, Integer, [String])],++writeFiles2 :: String -> String -> [(String, Int)] -> IO ()+writeFiles2 tmpdir pathname forms = mapM_ go forms+ where go (x, _)+ = do filecontent <- Data.ByteString.readFile (tmpdir </> x)+ Data.ByteString.writeFile+ (pathname ++ (Prelude.last (splitOn "/" x)))+ filecontent++data LatexConfig = LatexConfig{figures :: [Maybe ImageInfo], title :: String, fullConfig :: FullConfig, content :: String, hostname :: String, theResult :: CompileResult, onlyTables :: Bool,- lang :: Maybe String, theTempDir :: String}- + lang :: Maybe String, theTempDir :: String,+ formulas :: [(String, Int)], figHTML :: String}+ runLaTeX :: LatexConfig -> ImperativeMonad ByteString runLaTeX config = liftIO (withSystemTempDirectory "MediaWiki2LaTeX" (runLaTeXCallback config))- + runLaTeXCallback :: LatexConfig -> FilePath -> IO ByteString runLaTeXCallback config pathname = do extract pathname+ case (ImperativeState.headers (fullConfig config)) of+ Just x -> do d <- readDirectoryWith Data.ByteString.readFile+ (x ++ "/./")+ _ <- writeDirectoryWith Data.ByteString.writeFile+ d{anchor = pathname </> "document/headers"}+ return ()+ _ -> return ()+ if os == "linux" then return () else+ do d <- readDirectoryWith Data.ByteString.readFile+ ((mainPath (fullConfig config)) ++ "../fonts/main/")+ _ <- writeDirectoryWith Data.ByteString.writeFile+ d{anchor = pathname ++ "/document/"}+ return () Tools.writeFile (pathname ++ "/document/main/main.tex") (content config)+ Tools.writeFile (pathname ++ "/document/index.html")+ ((html (theResult config)) +++ "<h2>List of Figures</h2>" ++ (figHTML config)) Tools.writeFile (pathname ++ "/document/headers/svg.tex") (if vector (fullConfig config) then "\\newcommand{\\SVGExtension}{pdf}" else@@ -234,41 +273,59 @@ Tools.writeFile (pathname ++ "/document/headers/paper.tex") ("\\KOMAoption{paper}{" ++ (paper (fullConfig config)) ++ "}") if (onlyTables config) then return () else- All.writeFiles (theTempDir config) (mainPath (fullConfig config))- (pathname ++ "/document/images/")- (figures config)- (resolution (fullConfig config))- (galleryNumbers (theResult config))+ do myprint " preparing images for LaTeX document"+ All.writeFiles (theTempDir config) (mainPath (fullConfig config))+ (pathname ++ "/document/images/")+ (figures config)+ (resolution (fullConfig config))+ (galleryNumbers (theResult config))+ All.writeFiles2 (theTempDir config)+ (pathname ++ "/document/formulas/")+ (formulas config) cwd <- getCurrentDirectory setCurrentDirectory (pathname ++ "/document/main") case (ImperativeState.copy (fullConfig config)) of- Just x -> do d <- readDirectoryWith Data.ByteString.readFile "../../document/"+ Just x -> do d <- readDirectoryWith Data.ByteString.readFile+ "../../document/" _ <- writeDirectoryWith Data.ByteString.writeFile d{anchor = x} return () _ -> return () _ <- forM- ((if onlyTables config then [1] else [1, 2]) :: [Integer])- (\ _ ->- system- ((if os == "linux" then "xelatex" else- (mainPath (fullConfig config)) ++- "..\\miktex\\miktex\\bin\\pdflatex.exe")- ++ " --interaction=nonstopmode main.tex"))- _ <- ((if onlyTables config then return () else system- ((if os == "linux" then "makeindex" else- (mainPath (fullConfig config)) ++- "..\\miktex\\miktex\\bin\\makeindex.exe")- ++ " main")>> return ()))+ ((if onlyTables config then [1] else+ if ((outputType (fullConfig config)) /= PlainPDF) then [] else+ [1, 2])+ :: [Integer])+ (\ r ->+ do if (onlyTables config) then return () else+ myprint (" generating PDF file. LaTeX run " ++ (show r) ++ " of 4")+ mysystem+ ((if os == "linux" then "buf_size=10000000 xelatex" else+ (mainPath (fullConfig config)) +++ "..\\miktex\\miktex\\bin\\xelatex.exe")+ ++ " --interaction=batchmode main.tex"))+ _ <- ((if onlyTables config then return () else+ mysystem+ ((if os == "linux" then "makeindex" else+ (mainPath (fullConfig config)) +++ "..\\miktex\\miktex\\bin\\makeindex.exe")+ ++ " main")+ >> return ())) _ <- forM- ((if onlyTables config then [] else [1, 2]) :: [Integer])- (\ _ ->- system- ((if os == "linux" then "xelatex" else- (mainPath (fullConfig config)) ++- "..\\miktex\\miktex\\bin\\pdflatex.exe")- ++ " --interaction=nonstopmode main.tex"))+ ((if+ (onlyTables config) ||+ ((outputType (fullConfig config)) /= PlainPDF)+ then [] else [3, 4])+ :: [Integer])+ (\ r ->+ do if (onlyTables config) then return () else+ myprint (" generating PDF file. LaTeX run " ++ (show r) ++ " of 4")+ mysystem+ ((if os == "linux" then "buf_size=10000000 xelatex" else+ (mainPath (fullConfig config)) +++ "..\\miktex\\miktex\\bin\\xelatex.exe")+ ++ " --interaction=batchmode main.tex")) result <- if (onlyTables config) then- do _ <- system+ do _ <- mysystem ((if os == "linux" then "" else (mainPath (fullConfig config)) ++ "..\\pdftotext\\") ++ "pdftotext main.pdf main.txt")@@ -277,83 +334,249 @@ case splitOn "\n" te of (x : _) -> return (pack (encode (strip "pt\r" x))) _ -> return (pack (encode ""))- else Data.ByteString.readFile "main.pdf"+ else+ case outputType (fullConfig config) of+ PlainPDF -> Data.ByteString.readFile "main.pdf"+ ZipArchive -> do setCurrentDirectory pathname+ a <- addFilesToArchive [OptRecursive] emptyArchive+ ["document"]+ Data.ByteString.writeFile "main.zip"+ (toStrict (fromArchive a))+ Data.ByteString.readFile "main.zip"+ OdtFile -> do setCurrentDirectory ".."+ mysystem "libreoffice --headless --convert-to odt index.html"+ mysystem "libreoffice --headless --convert-to docx index.odt"+ mysystem "libreoffice --headless --convert-to odt index.docx"+ Data.ByteString.readFile "index.odt"+ EPubFile -> do mysystem "ebook-convert ../index.html .epub"+ Data.ByteString.readFile "index.epub" setCurrentDirectory cwd return result- ++ex :: ProcessHandle -> Handle -> Handle -> IO ()+ex h o e+ = do b <- hReady stdin+ if b then+ do terminateProcess h+ exitFailure+ else do return ()+ v <- tryIOError (hWaitForInput e 0)+ let xo+ = case v of+ Right j -> j+ _ -> False+ _ <- if xo then hGetChar e else return ' '+ w <- tryIOError (hWaitForInput o 0)+ let yo+ = case w of+ Right j -> j+ _ -> False+ _ <- if yo then hGetChar o else return ' '+ y <- getProcessExitCode h+ case y of+ Just _ -> do hClose o+ hClose e+ return ()+ _ -> ex h o e++mysystem :: String -> IO ()+mysystem x+ = if os == "linux" then+ do (_, o, e, h) <- runInteractiveCommand x+ ex h o e+ return ()+ else+ do _ <- system x+ return ()+ getLang :: URL -> IO (Maybe String) getLang u = let theUrl = exportURL u in do yy <- geturl theUrl case (deepGet2 "html" (parseit minparsers yy)) of ((Environment Tag (TagAttr _ m) _) : []) -> return $- Data.Map.lookup "lang" m+ Data.Map.Strict.lookup "lang" m _ -> return $ Nothing- + catchFun :: IOException -> IO String catchFun _ = return ""- + strip :: (Eq a) => [a] -> [a] -> [a]-strip l = dropWhileRev isBad . dropWhile isBad+strip l = reverse . (dropWhile isBad) . reverse . dropWhile isBad where isBad x = x `elem` l- + latexPostamble :: String latexPostamble = "\n\\end{longtable}\n\\pagebreak"- ++runCtrb :: String -> ImperativeMonad ()+runCtrb dir+ = do t <- liftIO $ Tools.readFile (dir </> "input")+ cr <- imgContribback ((read t) :: (Maybe ImageInfo))+ liftIO $ Tools.writeFile (dir </> "output") (show cr)+ imgContrib ::- MVar [Maybe (String, Integer, [String])] ->- ImperativeMonad (MVar (Maybe (String, Maybe String)))-imgContrib z- = do x <- liftIO (readMVar z)- xx <- mapM imgContrib2 x- li <- liftIO (liftList (return . msum) xx)- liftIO (liftA go li)+ (Maybe ImageInfo) ->+ ImperativeMonad ((Maybe (String, Maybe String)))+imgContrib x+ = do systempdir <- liftIO getTemporaryDirectory+ tempdir <- liftIO $+ createTempDirectory systempdir "MediaWiki2LaTeXImgContrib"+ liftIO $ Tools.writeFile (tempdir </> "input") (show x)+ _ <- liftIO $+ system+ ("mediawiki2latex -x " +++ (Hex.hex (show (fullconfigbase{imgctrb = Just tempdir}))))+ t <- liftIO $ Tools.readFile (tempdir </> "output")+ return (read t)++imgContribback ::+ (Maybe ImageInfo) ->+ ImperativeMonad ((Maybe (String, Maybe String)))+imgContribback z+ = do x <- return z+ xx <- imgContrib2 x+ liftIO (go xx) where go (Just xxx) = return (Just xxx) go _ = return (Just ("", Nothing))- + imgContrib2 ::- Maybe (String, Integer, [String]) ->- ImperativeMonad (MVar (Maybe (String, Maybe String)))-imgContrib2 (Just (_, _, x))- = do img <- getContributors x- ffi <- liftIO $ liftA (return . fst) img- fif <- liftIO (liftList2 (return . ffun . contribsum) ffi)- ssn <- liftIO $ liftA (return . snd) img- sns <- liftIO (liftList2 (return . msum) ssn)- liftIO (liftA2 fun fif sns)- where - ffun :: Map String Contributor -> String+ Maybe ImageInfo -> ImperativeMonad ((Maybe (String, Maybe String)))+imgContrib2 (Just x)+ = do img <- getContributors (contributorUrls x)+ ffi <- liftIO $ (return . fst) img+ fif <- liftIO ((return . ffun . contribsum) ffi)+ ssn <- liftIO $ (return . snd) img+ sns <- liftIO ((return . msum) ssn)+ liftIO ((fun fif sns))+ where ffun :: Map String Contributor -> String ffun i = intercalate ", " (keys (i))- + fun :: String -> Maybe String -> IO (Maybe (String, Maybe String)) fun fi sn = return (Just (fi, sn))-imgContrib2 _ = liftIO (base Nothing)- -makeImgList ::- [MVar [Maybe (String, Integer, [String])]] ->- ImperativeMonad String+imgContrib2 _ = do liftIO (return Nothing)++makeImgList :: [(Maybe ImageInfo)] -> ImperativeMonad String makeImgList imgs2 = do ccontrib <- mapM (imgContrib) imgs2- cccontrib <- liftIO (liftList (return . id) ccontrib)- contrib <- liftIO (readMVar cccontrib)- imgs <- liftIO (mapM readMVar imgs2)+ cccontrib <- liftIO (mapM (return . id) ccontrib)+ contrib <- liftIO (return cccontrib)+ let imgs = imgs2 let z = concat- (map go (zip (zip ([1 ..] :: [Integer]) contrib) (concat imgs)))+ (map go (zip (zip ([1 ..] :: [Integer]) contrib) imgs)) return ((toString latexPreamble) ++ z ++ (latexPostamble))- where go (((i, Just (con, lic)), Just (_, _, (_ : (u : _)))))+ where go ((i, Just (con, lic)), Just info) = "\\href{" ++- (replace2 (replace2 (concat (map chartransforlink u)) "//" "/")- "http:/"- "http://")+ (replace2+ (replace2+ (concat (map chartransforlink (exportURL (descriptionUrl info))))+ "//"+ "/")+ "https:/"+ "https://") ++ "}{" ++ (show i) ++ "}& " ++ con ++ "&" ++ (fromMaybe "" lic) ++ "\\\\ \\hline \n" go (((i, _), _)) = (show i) ++ "&&\\\\ \\hline \n"- ++makeImgListHTML :: [(Maybe ImageInfo)] -> ImperativeMonad String+makeImgListHTML imgs2+ = do ccontrib <- mapM (imgContrib) imgs2+ cccontrib <- liftIO (mapM (return . id) ccontrib)+ contrib <- return cccontrib+ imgs <- liftIO (return imgs2)+ let z = concat+ (map go (zip (zip ([1 ..] :: [Integer]) contrib) imgs))+ return+ ("<table rules=\"all\"><tr><td>Number</td><td>Contributors</td><td>License</td></tr>"+ ++ z ++ "</table>")+ where go ((i, Just (con, lic)), Just info)+ = "<tr><td><a href=\"" +++ (replace2 (replace2 (((exportURL (descriptionUrl info)))) "//" "/")+ "https:/"+ "https://")+ +++ "\">" +++ (show i) +++ "</a></td><td>" +++ con ++ "</td><td>" ++ (fromMaybe "" lic) ++ "</td></tr>"+ go (((i, _), _)) = (show i) ++ "&&\\\\ \\hline \n"++makeformulas ::+ String ->+ String -> [Anything Char] -> ImperativeMonad [(String, Int)]+makeformulas p tempdir ll+ = do x <- allinfo+ return $ concat x+ where allinfo :: ImperativeMonad [[(String, Int)]]+ allinfo = mapM processNode ll+ + processNode :: Anything Char -> ImperativeMonad [(String, Int)]+ processNode (Environment Math _ l)+ = do myname <- return (((hex (show (hash (mathTransform l))))))+ sz <- liftIO+ (do Tools.writeFile (tempdir </> (myname ++ ".tex"))+ ("\\documentclass{article}\n\\usepackage{color}\n\\input{./defaultcolors}\n\\usepackage{amsfonts}\n\\usepackage{amsmath}\n\\begin{document}\n\\thispagestyle{empty}\n$"+ ++ (mathTransform l) ++ "$\n\\end{document}")+ Static.writeFiles tempdir headerFiles+ mysystem ("latex2png " ++ (tempdir </> (myname ++ ".tex")))+ sz <- mysize (tempdir </> (myname ++ ".png"))+ mysystem+ ("latex2png -c -d 1200 " ++ (tempdir </> (((myname)) ++ ".tex")))+ print (mathTransform l)+ return sz)+ return [(myname ++ ".png", sz)]+ processNode (Environment BigMath _ l)+ = do myname <- return (((hex (show (hash (mathTransform l))))))+ sz <- liftIO+ (do Tools.writeFile (tempdir </> (myname ++ ".tex"))+ ("\\documentclass{article}\n\\usepackage{color}\n\\input{./defaultcolors}\n\\usepackage{amsfonts}\n\\usepackage{amsmath}\n\\begin{document}\n\\thispagestyle{empty}\n$"+ ++ (mathTransform l) ++ "$\n\\end{document}")+ Static.writeFiles tempdir headerFiles+ mysystem ("latex2png " ++ (tempdir </> (myname ++ ".tex")))+ sz <- mysize (tempdir </> (myname ++ ".png"))+ mysystem+ ("latex2png -c -d 1200 " ++ (tempdir </> (((myname)) ++ ".tex")))+ print (mathTransform l)+ return sz)+ return [(myname ++ ".png", sz)]+ processNode (Environment _ _ l) = (makeformulas p tempdir l)+ processNode _ = return []+ + mysize :: String -> IO Int+ mysize fn+ = do _ <- system+ ((getConvert p) +++ "-verbose " +++ fn +++ " -format '%w' " +++ tempdir +++ "nullfile.bmp" +++ " > " ++ tempdir ++ "dump2 2> " ++ tempdir ++ "dump")+ dump <- Tools.readFile (tempdir ++ "dump")+ case+ reverse+ (Prelude.filter (\ x -> (trim x) /= "") (splitOn "\n" dump))+ of+ (x : _) -> case splitOn " " x of+ (_ : (_ : (y : _))) -> case splitOn "x" y of+ (z : _) -> case reads z of+ [(ii, _)] -> do return+ ii+ _ -> return 0+ _ -> return 0+ _ -> return 0+ _ -> return 0++jjoin :: String -> String -> String+jjoin theBody listOfFiguers+ = ((toString (latexHeader)) +++ theBody ++ listOfFiguers ++ (toString latexFooter))+ all :: FullConfig -> ImperativeMonad () all cfg- = do systempdir <- liftIO getTemporaryDirectory+ = do liftIO $ myprint " processing started"+ systempdir <- liftIO getTemporaryDirectory tempdir <- liftIO $ createTempDirectory systempdir "MediaWiki2LaTeXImages" st <- get@@ -363,44 +586,95 @@ let uurl = replace2 (if (take 8 (inputUrl cfg)) == "https://" then- "http://" ++ (drop 8 (inputUrl cfg)) else+ "https://" ++ (drop 8 (inputUrl cfg)) else if (take 7 (inputUrl cfg)) == "http://" then (inputUrl cfg) else- "http://" ++ (inputUrl cfg))+ "https://" ++ (inputUrl cfg)) "_" " " purl <- parseUrl uurl language <- liftIO $ getLang (UrlAnalyse.url purl) put st{fullUrl = purl} minInit+ liftIO $ myprint " downloading article and contributor information" text <- load (runMode cfg)- result <- compile (runMode cfg) text templates []+ liftIO $ myprint " parsing article text"+ theFormulas <- if (outputType cfg) `elem` [EPubFile, OdtFile] then+ makeformulas (mainPath cfg) tempdir+ (printPrepareTree+ (parseit (if (runMode cfg) == HTML then minparsers else parsers)+ text))+ else return []+ liftIO+ (myprint+ (" number of bytes to be parsed: " +++ (show (Data.List.length text))))+ result <- Compiler.compile (runMode cfg) text templates [] ""+ Nothing+ (Map.fromList theFormulas)+ ((outputType cfg) `elem` [EPubFile, OdtFile])+ liftIO $+ myprint+ " forking threads to download of images and contributor information on them"+ liftIO+ (myprint+ (" number of images going to be downloaded: " +++ (show (Data.List.length (images result))))) theImages <- getImages tempdir (images result) (wikiUrl purl)- joined <- join (body result) ""- makeChess+ let joined = jjoin (body result) "" let theConfig = LatexConfig{content = joined, figures = [], All.title = (makeTitle result purl), fullConfig = cfg, All.hostname = (UrlAnalyse.hostname purl), theResult = result,- onlyTables = True, lang = language, theTempDir = tempdir}+ onlyTables = True, lang = language, theTempDir = tempdir,+ formulas = theFormulas, figHTML = ""}+ liftIO $ myprint " precompiling table columns"+ let cols = (sum (map Data.List.length (tablelist result)))+ ior <- liftIO (newIORef (0 :: Integer))+ liftIO+ (myprint (" number of columns to be compiled: " ++ (show cols))) tabs <- mapM (\ x -> mapM (\ y ->- runLaTeX- theConfig{content =- (toString (latexTableHeader)) ++- y ++ (toString latexTableFooter)})+ do liftIO (modifyIORef ior (+ 1))+ cc <- liftIO (readIORef ior)+ liftIO (myprint (" precompiling column number " ++ (show cc)))+ runLaTeX+ theConfig{content =+ (toString (latexTableHeader)) +++ y ++ (toString latexTableFooter)}) x) (tablelist result)- newResult <- compile (runMode cfg) text templates tabs+ liftIO $ myprint " generating LaTeX document"+ liftIO+ (myprint+ (" number of bytes to be parsed: " +++ (show (Data.List.length text))))+ newResult <- Compiler.compile (runMode cfg) text templates tabs+ (makeTitle2 result purl)+ language+ (Map.fromList theFormulas)+ ((outputType cfg) `elem` [EPubFile, OdtFile])+ liftIO $+ myprint+ " joining threads to download the images and contributor information on them"+ liftIO+ (myprint+ (" number of images to be processed: " +++ (show (Data.List.length (images result))))) pp <- makeImgList theImages- contrib <- makeContributors (Just (UrlAnalyse.url purl))- newContent <- join (body newResult) (contrib ++ pp)+ pphtml <- makeImgListHTML theImages+ (contrib, contribHTML) <- makeContributors+ (Just (UrlAnalyse.url purl))+ let newContent = jjoin (body newResult) (contrib ++ pp) thetheImages <- liftIO $- do ii <- mapM (readMVar) theImages- return (concat ii)+ do ii <- return theImages+ return ii+ liftIO $ myprint " preparing for PDF generation" pdf <- runLaTeX theConfig{onlyTables = False, theResult = newResult,- content = newContent, figures = thetheImages}+ content = newContent, figures = thetheImages,+ figHTML = pphtml ++ contribHTML ++ "</body></html>"} liftIO (Data.ByteString.writeFile (outputFilename cfg) pdf) liftIO $ removeDirectoryRecursive tempdir+ liftIO $ myprint " finished"
src/Babel.hs view
@@ -1,4 +1,24 @@-makeBabelHeader::ImperativeMonad-makeBabelHeader = return () -module Main (main) where+module Babel where+import Static+import Data.List.Split (splitOn)+import qualified Data.Map+import Data.Maybe+import Codec.Binary.UTF8.String+import Data.ByteString+ hiding (take, reverse, dropWhile, takeWhile, drop, map, concat,+ elem, zip, intercalate, init, tails, isPrefixOf, any, length, null,+ hPutStr)++makeBabel :: Maybe String -> [Char] -> String+makeBabel b x+ = case Data.Map.lookup (fromMaybe xx b) m of+ Just v -> decode . unpack $ v+ _ -> case Data.Map.lookup "en" m of+ Just w -> decode . unpack $ w+ _ -> ""+ where m = Data.Map.fromList babelFiles+ xx+ = case splitOn "." x of+ (z : _) -> z+ _ -> "en"
src/BaseFont.hs view
@@ -1,18 +1,24 @@-+{-| general Fonts configuration modules -} module BaseFont where import Data.Char import Data.Array import Data.Tuple- ++{-| Basic Fontstyle, may be either normal of monospaced or small caps -}+ data FontStyleBase = Normal | Mono | Smallcaps deriving (Eq, Ord, Show)- ++{-| Full discription of style of a font. Consists of Basic Fontstyle plus boolean for bold and/or italic -}+ data FontStyle = FontStyle{stylebase :: FontStyleBase, bold :: Bool, italic :: Bool} deriving (Eq, Ord, Show)- ++{-| Font, a list of ttf font file currently used by mediawiki2latex -}+ data Font = GnuUnifont | WenQuanYiZenHei | FreeMono@@ -32,7 +38,9 @@ | ComputerModernRomanItalic | ComputerModernRomanBoldItalic deriving (Eq, Ord, Show, Ix)- ++{-| list of Fonts. The first element in the list is the fonts that is preferred to be used. If it can not be used for some reason the next font in the list is used. Note that the list is denoted in reverse order and put into the right order by the reverse function in the way it is just written at this point of the source file -}+ fonts :: [Font] fonts = reverse@@ -43,21 +51,29 @@ ComputerModernTypeWriterBoldItalic, ComputerModernRoman, ComputerModernRomanBold, ComputerModernRomanItalic, ComputerModernRomanBoldItalic]- ++{-| enumation of Fonts. To store the Fonts database efficiently on disc and to read it to memory quickly interger indices are used. The Integers are low in magnitude and thus stored as chars on disc. -}+ fontList :: [(Font, Int)] fontList = zip fonts [(ord 'A') ..]- ++{-| converts font to char. See also fontList in this source file -}+ fromFontToChar :: Font -> Char fromFontToChar f = chr ((array (GnuUnifont, ComputerModernRomanBoldItalic) fontList) ! f)- ++{-| converts from char to font. See also fontList in this source file -}+ fromCharToFont :: Char -> Font fromCharToFont c = (array (ord ('A'), ord ('A') + (length fontList) - 1) (map swap fontList)) ! (ord c)- ++{-| converts from Fonts to path of ttf file on disc. -}+ getttf :: Font -> [Char] getttf ComputerModernTypeWriter = "/usr/share/fonts/truetype/cmu/cmuntt.ttf"@@ -93,7 +109,9 @@ getttf GnuUnifont = "/usr/share/fonts/truetype/unifont/unifont.ttf" getttf WenQuanYiZenHei = "/usr/share/fonts/truetype/wqy/wqy-zenhei.ttc"- ++{-| defines the FontStyle for each ttf font file. See also FontStyle in this source file. -}+ getstyle :: Font -> FontStyle getstyle GnuUnifont = FontStyle{stylebase = Normal, bold = False, italic = False}
src/Compiler.hs view
@@ -1,318 +1,110 @@-+{-| module to compile mediawiki page to latex documents. This module is called from the All module.|-} module Compiler where import ImperativeState import MyState-import Text.ParserCombinators.Parsec-import Data.List (isInfixOf) import MediaWikiParseTree import MediaWikiParser import LatexRenderer+import HtmlRenderer import Tools+import System.FilePath.Posix import qualified Data.Map as Map import Data.Set ()-import Data.Maybe-import qualified System.Directory as Dir-import Data.List.Split-import Control.Monad-import Network.URI-import Codec.Binary.UTF8.String import Control.Monad.State import UrlAnalyse import Data.ByteString.UTF8 (toString) import Data.ByteString hiding (take, reverse, dropWhile, takeWhile, drop, map, concat, elem, length, zip, head, filter, minimum, isInfixOf)- ++runCompile :: String -> ImperativeMonad ()+runCompile dir+ = do t <- liftIO $ Tools.readFile (dir </> "input")+ cr <- return (printPrepareTree (parseit minparsers t))+ liftIO $ Tools.writeFile (dir </> "output") (show cr)++{-| main function to compile mediawiki pages |-}+ compile :: RunMode ->- String -> String -> [[ByteString]] -> ImperativeMonad CompileResult-compile theRunMode text templates tabs+ String ->+ String ->+ [[ByteString]] ->+ String ->+ Maybe String ->+ Map.Map String Int -> Bool -> ImperativeMonad CompileResult+compile theRunMode text templates tabs mytitle mylanguage formulas+ b = do st <- get- --liftIO $ print (printPrepareTree(parseit minparsers text)) case theRunMode of StandardTemplates -> return- (run2 (parseit parsers text) (hostname . fullUrl $ st) templates- tabs)+ (run b mylanguage mytitle (parseit parsers text)+ (parseit parsers text)+ (hostname . fullUrl $ st)+ templates+ tabs+ formulas) UserTemplateFile _ -> return- (run2 (parseit parsers text) (hostname . fullUrl $ st) templates- tabs)+ (run b mylanguage mytitle (parseit parsers text)+ (parseit parsers text)+ (hostname . fullUrl $ st)+ templates+ tabs+ formulas) HTML -> return- (run2 (printPrepareTree (parseit minparsers text))+ (run b mylanguage mytitle+ (printPrepareTree (parseit minparsers text))+ (printPrepareTree (parseit minparsers text)) (hostname . fullUrl $ st) templates- tabs)- ExpandedTemplates -> return- (run2 (parseit parsers text) (hostname . fullUrl $ st) templates- tabs)- -{-DHUN| pathname of the temporary directory of the compiler |DHUN-}- + tabs+ formulas)+ Book -> do return+ (run b mylanguage mytitle (loadacu st) (loadacu st)+ (hostname . fullUrl $ st)+ templates+ tabs+ formulas)+ ExpandedTemplates -> do return+ (run b mylanguage mytitle (parseit parsers text)+ (parseit parsers text)+ (hostname . fullUrl $ st)+ templates+ tabs+ formulas)++{-| pathname of the temporary directory of the compiler |-}+ dirpref :: [Char] dirpref = "../tmp/compiler/"- -{-DHUN| converts a wiki source document received from mediawiki when requesting it for Special:Export to a parse tree to be converted to LaTeX be treeToLaTeX3. It also signals to compiler.py that the source code was read using the temporary compiler directory |DHUN-}- ++{-| converts a wiki source document received from mediawiki when requesting it for Special:Export to a parse tree to be converted to LaTeX be treeToLaTeX3. It also signals to compiler.py that the source code was read using the temporary compiler directory |-}+ shortparse :: String -> IO [Anything Char] shortparse x = do Tools.writeFile (dirpref ++ "done") "" return (parseit parsers x)- -{-DHUN| a function to get HTML elements out of a parse tree. The first parameter is name of the tag to be looked for. The second parameter is a key in the attributes of that element that has to be present for the element to be considered. The third parameter is a value that has to be found under the given key in the attributes of the element, in order for the element to be part of the returned output list. The fourth parameter is the parse tree. |DHUN-}- -deepGet ::- [Char] -> String -> [Char] -> [Anything a] -> [Anything a]-deepGet t k v ll = concat $ map go ll- where go (Environment Tag (TagAttr tag m) l)- | (tag == t) && ((Map.lookup k m) == (Just v)) =- [Environment Tag (TagAttr tag m) l]- go (Environment _ _ l) = (deepGet t k v l)- go _ = []- -{-DHUN| flattens out the HTML 'a' tags. That is it replaces each 'a' element with its content. That is everything that is between its opening and its closing tag. The only parameter of this function is the parse tree to be processed. This function returns the parse tree with the 'a' HTML elements flattened |DHUN-}- -reducea :: [Anything Char] -> [Anything Char]-reducea ll = concat (map go ll)- where - go :: Anything Char -> [Anything Char]- go (Environment Tag (TagAttr "a" _) l) = l- go (Environment x y l) = [Environment x y (reducea l)]- go x = [x]- -{-DHUN| flattens out the HTML 'div' tags, which have got a 'class' attributes present with the value 'noresize'. That is it replaces each 'div' element with the properties mentioned above by its content. That is everything that is between its opening and its closing tag. The only parameter of this function is the parse tree to be processed. This function returns the parse tree with the 'div' HTML elements with the properties given above flattened |DHUN-}- -reducediv :: [Anything Char] -> [Anything Char]-reducediv ll = concat (map go ll)- where - go :: Anything Char -> [Anything Char]- go (Environment Tag (TagAttr "div" m) l)- | (Map.lookup "class" m) == (Just "noresize") = l- go (Environment x y l) = [Environment x y (reducea l)]- go x = [x]- -{-DHUN| takes a parse tree that was created form the HTML returned by MediaWiki when being requested for the print version of a wiki page. And returns a modified version of that parse tree ready for being converted to LaTeX with treeToLaTeX3 |DHUN-}- -printPrepareTree :: [Anything Char] -> [Anything Char]-printPrepareTree ll = concat (map printPrepareNode ll)- where - printPrepareNode :: Anything Char -> [Anything Char]- printPrepareNode (Environment Tag (TagAttr "div" mm) l)- | (Map.lookup "class" mm) == (Just "thumbinner") =- case- do (m, llll) <- case filter (mypred "a") (reducediv l) of- [(Environment Tag (TagAttr "a" mmm) lll)] -> return (mmm, lll)- _ -> mzero- tt <- case filter (mypred "div") (reducediv l) of- [(Environment Tag (TagAttr "div" mmm) tt)] | (Map.lookup "class"- mmm)- == (Just "thumbcaption")- ->- return .- (dropWhile (== (C '\n')))- . (filter magnpred)- $ tt- _ -> mzero- return $ imgfun m llll (Just tt)- of- Just x -> x- _ -> printPrepareTree l- printPrepareNode (Environment Wikitable (TagAttr "table" m) _)- | (Map.lookup "class" m) == (Just "toc") = []- printPrepareNode (Environment Tag (TagAttr "div" m) _)- | ((Map.lookup "class" m) == (Just "toc") ||- (Map.lookup "id" m) == (Just "toc"))- = []- printPrepareNode (Environment Wikitable (TagAttr "table" m) _)- | (Map.lookup "class" m) == (Just "navbox") = []- printPrepareNode (Environment Tag (TagAttr "title" _) _) = []- printPrepareNode (Environment Tag (TagAttr "div" m) _)- | (Map.lookup "id" m) == (Just "siteSub") = []- printPrepareNode (Environment Tag (TagAttr "div" m) _)- | (Map.lookup "id" m) == (Just "jump-to-nav") = []- printPrepareNode (Environment Tag (TagAttr "div" m) _)- | (Map.lookup "id" m) == (Just "footer") = []- printPrepareNode (Environment Tag (TagAttr "div" m) _)- | (Map.lookup "id" m) == (Just "p-lang") = []- printPrepareNode (Environment Tag (TagAttr "div" m) _)- | (Map.lookup "id" m) == (Just "contentSub") = []- printPrepareNode (Environment Tag (TagAttr "div" m) _)- | (Map.lookup "class" m) == (Just "printfooter") = []- printPrepareNode (Environment Tag (TagAttr "span" m) _)- | (Map.lookup "class" m) == (Just "mw-cite-backlink") = []- printPrepareNode (Environment Tag (TagAttr "div" m) _)- | (Map.lookup "id" m) == (Just "mw-navigation") = []- printPrepareNode (Environment Tag (TagAttr "sup" m) l)- | (Map.lookup "class" m) == (Just "reference") =- [Environment Tag (TagAttr "sup" m) (reducea l)]- printPrepareNode (Environment Tag (TagAttr "li" m) l)- | (Map.lookup "class" m) == (Just "gallerybox") =- case- (do llll <- case deepGet "div" "class" "thumb" l of- [Environment Tag (TagAttr "div" _) lll] -> return lll- _ -> mzero- (mmm, lll) <- case deepGet "a" "class" "image" llll of- [Environment Tag (TagAttr "a" mmm) lll] -> return (mmm, lll)- _ -> mzero- te <- case deepGet "div" "class" "gallerytext" l of- [Environment Tag (TagAttr "div" _) te] -> return te- _ -> mzero- return $ imgfun mmm lll (Just te))- of- Just x -> x- _ -> printPrepareTree l- printPrepareNode (Environment TableHeadColSep (TagAttr t m) l)- = [Environment TableHeadColSep (TagAttr t m) (l++ (map (\x->Environment Attribute (Attr x) []) (Map.toList m)))]- printPrepareNode (Environment TableColSep (TagAttr t m) l)- = [Environment TableColSep (TagAttr t m) (l++ (map (\x->Environment Attribute (Attr x) []) (Map.toList m)))]- printPrepareNode (Environment TableRowSep (TagAttr t m) l)- = [Environment TableRowSep (TagAttr t m) (l++ (map (\x->Environment Attribute (Attr x) []) (Map.toList m)))]- printPrepareNode (Environment Tag (TagAttr "pre" m) l)- = [Environment Preformat (TagAttr "pre" m) l]- printPrepareNode (Environment Tag (TagAttr "span" m) _)- | (Map.lookup "class" m) == (Just "editsection") = []- printPrepareNode (Environment Tag (TagAttr "span" m) _)- | (Map.lookup "class" m) == (Just "mw-editsection") = []- printPrepareNode (Environment Tag (TagAttr "a" m) l)- = case (Map.lookup "class" m) of- (Just "image") -> imgfun m l Nothing- _ -> case (Map.lookup "class" m) of- (Just "external free") -> [Environment Tag (TagAttr "a" m) []]- _ -> [Environment Tag (TagAttr "a" m) l]- printPrepareNode (Environment Tag (TagAttr "div" m) _)- | (Map.lookup "class" m) == (Just "bodyContent") = []- printPrepareNode (Environment Tag (TagAttr "img" m) l)- | (Map.lookup "class" m) == (Just "tex") =- case Map.lookup "alt" m of- Just x -> [Environment Math (TagAttr "math" Map.empty)- (map C- (replace2 (replace2 (replace2 x "&" "&") "<" "<") "gt;"- ">"))]- Nothing -> [(Environment Tag (TagAttr "img" m)- (printPrepareTree l))]- printPrepareNode (Environment Tag (TagAttr "div" m) l)- = case- do c <- Map.lookup "class" m- guard $ isInfixOf "source" c- return $- Environment Source- (TagAttr "source"- (Map.fromList [("lang", (takeWhile (/= ' ') c))]))- (deepFlatten l)- of- Nothing -> [Environment Tag (TagAttr "div" m) (printPrepareTree l)]- Just x -> [x]- printPrepareNode (Environment x y l)- = [Environment x y (printPrepareTree l)]- printPrepareNode x = [x]- - mypred :: String -> Anything Char -> Bool- mypred x y- = case y of- (Environment Tag (TagAttr z _) _) | z == x -> True- _ -> False- - magnpred :: Anything Char -> Bool- magnpred y- = case y of- (Environment Tag (TagAttr "div" m) _) | (Map.lookup "class" m) ==- (Just "magnify")- -> False- _ -> True- unEsc x- = let z = unEscapeString x in- if isUTF8Encoded z then decodeString z else z- imgfun m l tt- = maybeToList $- do t <- case- (fmap (parseit imgparsers) (Map.lookup "title" m)) `mplus` tt of- Just x -> return $ [C '|'] ++ x- Nothing -> return []- h <- case filter (mypred "img") l of- [(Environment Tag (TagAttr "img" mmm) _)] -> case- Map.lookup "src" mmm of- Just s -> if- length- (reverse- (splitOn- "/"- s))- >= 2- then- return- ("File:" ++- (unEsc- ((reverse- (splitOn- "/"- s))- !!- (if- "thumb"- `elem`- splitOn- "/"- s- then- 1- else- 0))))- else mzero- _ -> mzero- _ -> mzero- w <- case- case filter (mypred "img") l of- [(Environment Tag (TagAttr "img" mmm) _)] -> do ma <- Map.lookup- "width"- mmm- guard $ tt == Nothing- return ma- _ -> Nothing- of- Just x -> return $ [C '|'] ++ (map C (x ++ "px"))- Nothing -> return []- return (Environment Wikilink (Str "") ((map C h) ++ w ++ t))- -{-DHUN| return a parse tree of a source file. The first argument is the source file. The second argument is a list of command line parameter. If it contains the keyword print. The source file is understood to be the HTML code returned by mediawiki when being requested for the print version of a wiki page, otherwise it is understood to be the wiki source code of a wiki page, that is what you get when issuing a Special:Export request to mediawiki. This function return a parse tree ready to be turned into a latex document by treeToLaTeX3 |DHUN-}- ++{-| return a parse tree of a source file. The first argument is the source file. The second argument is a list of command line parameter. If it contains the keyword print. The source file is understood to be the HTML code returned by mediawiki when being requested for the print version of a wiki page, otherwise it is understood to be the wiki source code of a wiki page, that is what you get when issuing a Special:Export request to mediawiki. This function return a parse tree ready to be turned into a latex document by treeToLaTeX3 |-}+ getparse :: String -> [String] -> IO [Anything Char] getparse x args = if ("print" `elem` args) then printparse x else shortparse x- -{-DHUN| prepares a HTML document received from mediawiki when requesting it for the print version of a wiki page to a parse tree to be converted to LaTeX be treeToLaTeX3. It also signals to compiler.py that the source code was read using the temporary compiler directory |DHUN-}- ++{-| prepares a HTML document received from mediawiki when requesting it for the print version of a wiki page to a parse tree to be converted to LaTeX be treeToLaTeX3. It also signals to compiler.py that the source code was read using the temporary compiler directory |-}+ printparse :: String -> IO [Anything Char] printparse x = do Tools.writeFile (dirpref ++ "done") "" return (printPrepareTree (parseit minparsers x))- -{-DHUN| converts a wiki source document to a parse tree to be converted to LaTeX be treeToLaTeX3. The first parameter is that list of parsers. That is the list of environments to be recognized by the parser. This is usually either only plain HTML, or HTML mixed with mediawiki markup. The second parameter is the source code to be parsed. This function returns a parse tree |DHUN-}- -parseit :: [MyParser Char] -> String -> [Anything Char]-parseit pp x- = (parseit2- (decon2 (remake pp)- (parseAnything2- [MyStackFrame{endparser = pzero, startdata = Str "",- environment = Root, badparser = \ _ -> pzero, parsernumber = 0,- nestingdepth = 0}]- (remake pp)- []))- ('\n' : x))- -{-DHUN| helper function of parseit, not to be called directly. This function takes the parser for the grammar, in the sense of a parser of the parsec library, (so that is the final combined parser) as first argument. It takes the source code to be parsed (usually HTML of mediawiki markup mixed with HTML) as second and runs the parser on the source code. It returns the resulting parse tree. |DHUN-}- -parseit2 :: Parser [Anything Char] -> String -> [Anything Char]-parseit2 p input- = case (parse p "" input) of- Left _ -> []- Right x -> x- -{-DHUN| the pathname of the temporary directory |DHUN-}- ++{-| the pathname of the temporary directory |-}+ tmppath :: [Char] tmppath = "../tmp/"- -{-DHUN| the function takes a list of the following format as first input [([table1,column1],width_x),([table1,column2],width_y),...,([table2,column1],width_z),...] parameter. Thats is a list containing the maximum width for each column of each table of the document. The maximum width of the column is the width that the column could have if it was printed on paper of infinite size. So the size without line breaks. The second parameter is the accumulator which should be the empty map when calling this function from outside. The function returns a map mapping tablenumber to a map mapping columnnumbers to maximum columns width. This data structure contains all information needed to make the decisions on the final width of the columns in the document |DHUN-}- ++{-| the function takes a list of the following format as first input [([table1,column1],width_x),([table1,column2],width_y),...,([table2,column1],width_z),...] parameter. Thats is a list containing the maximum width for each column of each table of the document. The maximum width of the column is the width that the column could have if it was printed on paper of infinite size. So the size without line breaks. The second parameter is the accumulator which should be the empty map when calling this function from outside. The function returns a map mapping tablenumber to a map mapping columnnumbers to maximum columns width. This data structure contains all information needed to make the decisions on the final width of the columns in the document |-}+ maketabmap :: [([Int], Double)] -> Map.Map Int (Map.Map Int Double) ->@@ -326,9 +118,9 @@ Nothing -> Just (Map.singleton s1 b1) Just m1 -> Just (Map.insert s1 b1 m1) maketabmap _ m = m- -{-DHUN| prepare the result of maketabmap for further procession. Some indices are offset corrected. Space for the rules of the table is added to the width of the columns DHUN-}- ++{-| prepare the result of maketabmap for further procession. Some indices are offset corrected. Space for the rules of the table is added to the width of the columns -}+ postproctabmap :: (Fractional a, Num k1, Ord k1, Ord a) => Map.Map k (Map.Map k1 a) -> Map.Map k (Map.Map k1 a)@@ -337,19 +129,29 @@ = Map.delete 0 (Map.mapKeys (\ k -> k - 1) (Map.map (\ x -> (x + 12.333748 - (minimum (Map.elems m1)))) m1))- ++{-| datatype for the results of a compulation process. The field images contains the strings enlclose in double square brackes in the wiki used for image inclusion. The field body contains the body of the latex document compiled form the wiki documents. The field tablelist contains a list of lists of bodies of latex document containing the latex source for a single column. Those can be compiled with the propper headers and footers on arbitrary huge paper to determine the maximum reasonable width for a each column in each table of the document which is need for automatic calculation of column widths for the document. The field gallery numbers contain the image numbers of images include in the wiki source inside of galleries. These got a smaller dimension in cm in the final pdf document and can thus be dithers to a small width in pixels. The field title contains the title of the document if a template defining the title was part of the parse wiki source |-}+ data CompileResult = CompileResult{images :: [String], body :: String, tablelist :: [[String]],- galleryNumbers :: [Integer], title :: String}- -{-DHUN| the first parameter is the parse tree created by get parse of the document currently being processed. the second parameter is the URL under which the document was downloaded. the third parameter is the netloc describing the wiki this page belongs to. The fourth parameter is a mapping file defined by the user for the mapping of mediawiki templates to latex commands. the fifth parameter is a possible parse tree created by precious run the the should be added before the begging of the newly created parse tree. This function writes out all results to temporary files that will be further processed by compiler.py DHUN-}- -run2 ::- [Anything Char] ->- String -> String -> [[ByteString]] -> CompileResult-run2 parsetree netloc tmpl someTables+ galleryNumbers :: [Integer], title :: String, html :: String}+ deriving Show++{-| the first parameter is the parse tree created by get parse of the document currently being processed. the second parameter is the URL under which the document was downloaded. the third parameter is the netloc describing the wiki this page belongs to. The fourth parameter is a mapping file defined by the user for the mapping of mediawiki templates to latex commands. the fifth parameter is a possible parse tree created by precious run the the should be added before the begging of the newly created parse tree. This function writes out all results to temporary files that will be further processed by compiler.py -}++run ::+ Bool ->+ Maybe String ->+ String ->+ [Anything Char] ->+ [Anything Char] ->+ String ->+ String -> [[ByteString]] -> Map.Map String Int -> CompileResult+run bb mylanguage mytitle parsetree parsetree2 netloc tmpl+ someTables formulas = CompileResult{images = img, body = bdy, tablelist = theTables,- galleryNumbers = gals, title = tit}+ galleryNumbers = gals, title = tit,+ html = if bb then trda3 else []} where alldata2 g u = (treeToLaTeX3 ((snd . newtree $ g)) initialState{urld = analyseNetloc netloc}{tabmap = u,@@ -361,15 +163,27 @@ fst . newtree $ g})+ alldata3 g u+ = (treeToHtml3 formulas mylanguage mytitle ((snd . newtree $ g))+ initialState{urld = analyseNetloc netloc}{tabmap = u,+ templateMap =+ getUserTemplateMap+ (read tmpl :: [[String]])}{urls =+ mUrlState+ .+ fst .+ newtree+ $ g}) newtree g = makeLables g initialUrlState tm = (postproctabmap (maketabmap theNewSizes Map.empty)) (trda, trst) = (alldata2 parsetree tm)+ (trda3, _) = (alldata3 parsetree2 tm) img = (map (\ g -> ((replace '\n' ' ' g))) (getImages trst)) theTables = reverse (tablist trst) bdy = doUnicode trda gals = getGalleryNumbers trst tit = getTitle trst- + fun :: ByteString -> Double fun x = case reads (toString x) of@@ -379,70 +193,3 @@ = zip [1 ..] (map (\ x -> zip [1 ..] (map fun x)) someTables) theNewSizes = concat (map sizeFun theSizes) sizeFun (t, k) = map (\ (s, b) -> ([t, s], b)) k- -{-DHUN| the first parameter is the parse tree created by get parse of the document currently being processed. the second parameter is the URL under which the document was downloaded. the third parameter is the netloc describing the wiki this page belongs to. The fourth parameter is a mapping file defined by the user for the mapping of mediawiki templates to latex commands. the fifth parameter is a possible parse tree created by precious run the the should be added before the begging of the newly created parse tree. This function writes out all results to temporary files that will be further processed by compiler.py DHUN-}- -run ::- [Anything Char] -> String -> String -> [[Anything Char]] -> IO ()-run x z tmpl cur- = do y <- Prelude.readFile (tmppath ++ "imgnum")- d <- Dir.getDirectoryContents tmppath- dd <- return $- filter ((".size" ==) . reverse . (take 5) . reverse) d- ll <- mapM (\ xx -> Tools.readFile (tmppath ++ xx)) dd- lll <- return $- zip- (map- (\ xx ->- (map read) . (splitOn "_") . head . (splitOn ".") . (drop 5) $ xx)- dd)- (map read ll)- return ()- (trda, trst) <- return- ((((alldata2 (jj ++ x) y- (postproctabmap (maketabmap lll Map.empty))))))- Tools.writeFile (tmppath ++ "images")- (concat- (map (\ g -> ((replace '\n' ' ' g) ++ "\n")) (getImages trst)))- Tools.writeFile (tmppath ++ "ttt.zzz")- (show (reverse (tablist trst)))- Tools.writeFile (tmppath ++ "test.tex") (doUnicode trda)- _ <- mapM- (\ (xx, i) ->- mapM- (\ (yy, j) ->- Tools.writeFile- (tmppath ++ "table" ++ (show i) ++ "_" ++ (show j) ++ ".tex")- yy)- (zip xx ([1 ..] :: [Integer])))- (zip (reverse (tablist trst)) ([1 ..] :: [Integer]))- Tools.writeFile (tmppath ++ "final.state") (show trst)- Tools.writeFile (tmppath ++ "current2") (show (x))- Tools.writeFile (tmppath ++ "imgnum2")- (show ((length (getImages trst)) + (read y)))- Tools.writeFile (tmppath ++ "gals")- ((concat- (map (((++) "\n") . show)- (getGalleryNumbers (snd (alldata x y))))))- Tools.writeFile (tmppath ++ "title") (getTitle (snd (alldata x y)))- where jj = concat cur- alldata g y- = (treeToLaTeX3 ((snd . newtree $ g))- initialState{getJ = read y}{urld = analyseNetloc z}{templateMap =- getUserTemplateMap- (read tmpl ::- [[String]])}{urls =- mUrlState .- fst .- newtree- $ g})- alldata2 g _ u- = (treeToLaTeX3 ((snd . newtree $ g))- initialState{urld = analyseNetloc z}{tabmap = u,- templateMap =- getUserTemplateMap- (read tmpl :: [[String]])}{urls =- mUrlState .- fst . newtree- $ g})- newtree g = makeLables g initialUrlState
− src/Contributors.hs
@@ -1,10 +0,0 @@-addContribution::ImperativeMonad ()-addContribution= return ()--addPage::ImperativeMonad ()-addPage= return ()--getTex::ImperativeMonad String-getTex=return ""--module Main (main) where
− src/Font.hs
@@ -1,69 +0,0 @@-import Data.Tuple-import BaseFont-import Data.Maybe-import Control.Monad-import Data.Array-import Data.Char-import System.Cmd----findfont::[Font]->[Font]->Font-findfont (x:xs) f= if x `elem` f then x else findfont f xs-findfont [] f= GnuUnifont---getArray::Font->IO (Array Int Bool)-getArray f = do _<-system ("python font.py "++(getttf f)++"> "++name)- text<-readFile filename- return $ array (0,(length text) -1) (zip [0..((length text) -1)] (zt text))- where- zt::[Char]->[Bool]- zt text=(map fun (zip [0..] text))- fun::(Int,Char)->Bool - fun (_,'T') = True- fun (i,_) = (chr i) `elem` "\n\r\t " - name=takeWhile (/='.') filename- ext =dropWhile (/='.') filename- filename = reverse ((takeWhile (/='/')) (reverse (getttf f)))- ----itbf s= [FontStyle{stylebase=s,bold=False,italic=False},FontStyle{stylebase=s,bold=True,italic=False},FontStyle{stylebase=s,bold=False,italic=True},FontStyle{stylebase=s,bold=True,italic=True}]--stylebasenext::FontStyleBase->FontStyleBase-stylebasenext Normal = Mono-stylebasenext Mono = Smallcaps-stylebasenext Smallcaps = Normal--styles =(itbf Normal)++(itbf Mono)++(itbf Smallcaps)--myfun as i fs = [f|(f,b)<-zip fonts (map (!i) as),b&&(fs==getstyle f)]--getdata::[Array Int Bool]->Int-> [([Font],FontStyle)]-getdata as i = zip (map (myfun as i) styles) styles---main = jjj--jjj = do arrs<-mapM getArray fonts- let chrs=array (0,2^16-1) (zip [0..2^16-1] (map (getdata arrs) [0..2^16-1])) - print [(s, map (fromFontToChar.f) [0..2^16-1])|(s,f)<-zip styles (map (getFont chrs) styles)] -----getFont::Array Int [([Font],FontStyle)]->FontStyle->Int->Font-getFont chars fontStyle i = if (mi<=i) && (i<=mx) then getf else def - where- (mi,mx) = bounds chars- def = GnuUnifont- ch= chars!i- swp = map swap ch- ff sty = (lookup sty swp)- gg sty = (ff sty) `mplus` (ff sty{italic= not (italic sty)}) `mplus` (ff sty{bold= not (bold sty)}) `mplus` (ff sty{italic= not (italic sty),bold= not (bold sty)})- hh sty = (gg sty) `mplus` (gg sty{stylebase= stylebasenext .stylebase $sty}) `mplus` (gg sty{stylebase= stylebasenext.stylebasenext.stylebase$ sty})- getf = fromMaybe def ((hh fontStyle)>>=return.(findfont fonts) )--module Main (main) where
src/FontTool.hs view
@@ -1,37 +1,55 @@-+{-| module to switch between different ttf fonts during latex code generation -} module FontTool where import MegaFont import BaseFont import Data.Char import Data.Array-import Data.Map hiding ((!))+import Data.Map.Strict hiding ((!)) import Data.Maybe import System.Info- ++{-| a map taking a FontStyle as key. (see FontStyle in the BaseFont module). The Values of a maps is and array. The array has got an integer index covering 16 bit. The elements of the arrows are chars. These chars can be converted to the paths of ttf files on disc. (see functions fromCharToFont and getttf in the module BaseFont on how to converts the char to a path to a ttf file on disc). The idea is that you got a 16 Bit unicode charter with certain font style properties. It put in this information in the this map and the array you get from it you get the idea ttf file to print that character in that fontstyle in a latex document -}+ megafont2 :: Map FontStyle (Array Int Char) megafont2- = Data.Map.fromList+ = Data.Map.Strict.fromList [(s, array ((0, (2 :: Int) ^ (16 :: Int) - 1) :: (Int, Int)) (zip ([0 .. (2 :: Int) ^ (16 :: Int) - 1] :: [Int]) f)) | (s, f) <- megafont]- ++{-| takes a fontstyle and a 16 bis unicode charater and give you the ideal font to print this character in a LaTeX docuemnt. See also megafont2 in this module -}+ getFont :: FontStyle -> Char -> Font getFont fontStyle c = fromMaybe GnuUnifont- ((Data.Map.lookup fontStyle megafont2) >>=- return . fromCharToFont . (! (ord c)))- + ((Data.Map.Strict.lookup fontStyle megafont2) >>=+ return .+ fromCharToFont .+ (! (if (ord c) > 65535 then ord (' ') else (ord c))))++{-| Takes a font and returns the LaTeX Command to switch to this particular font in xelatex -}+ fontsetter :: Font -> [Char] fontsetter f- = if os == "linux" then- "\\setmainfont" ++ inner ++ "\\setmonofont" ++ innermono else ""+ = "\\setmainfont" ++ inner ++ "\\setmonofont" ++ innermono where filename = reverse ((takeWhile (/= '/')) (reverse (getttf f))) pathname = reverse ((dropWhile (/= '/')) (reverse (getttf f)))- inner = "[Path=" ++ pathname ++ (mid f) ++ "]{" ++ filename ++ "}"+ inner+ = "{" +++ filename +++ "}" +++ "[" +++ (if os == "linux" then "Path=" ++ pathname else "") +++ (mid f) ++ "]" innermono- = "[Path=" ++ pathname ++ (midmono f) ++ "]{" ++ filename ++ "}"+ = "{" +++ filename +++ "}" +++ "[" +++ (if os == "linux" then "Path=" ++ pathname else "") +++ (midmono f) ++ "]" mid i | i `elem` [ComputerModernRoman, ComputerModernRomanBold,@@ -39,15 +57,15 @@ ComputerModernTypeWriter, ComputerModernTypeWriterBold, ComputerModernTypeWriterItalic, ComputerModernTypeWriterBoldItalic] =- ",UprightFont=cmunrm.ttf,BoldFont=cmunbx.ttf" ++- ",ItalicFont=cmunti.ttf,BoldItalicFont=cmunbi.ttf"+ ",UprightFont=cmunrm,BoldFont=cmunbx" +++ ",ItalicFont=cmunti,BoldItalicFont=cmunbi" mid i | i `elem` [FreeSerif, FreeSerifBold, FreeSerifBoldItalic, FreeSerifItalic, FreeMono, FreeMonoOblique, FreeMonoBold, FreeMonoBoldOblique] =- ",UprightFont=FreeSerif.ttf,BoldFont=FreeSerifBold.ttf," ++- "ItalicFont=FreeSerifItalic.ttf,BoldItalicFont=FreeSerifBoldItalic.ttf"+ ",UprightFont=FreeSerif,BoldFont=FreeSerifBold," +++ "ItalicFont=FreeSerifItalic,BoldItalicFont=FreeSerifBoldItalic" mid _ = "" midmono i | i `elem`@@ -56,17 +74,19 @@ ComputerModernTypeWriter, ComputerModernTypeWriterBold, ComputerModernTypeWriterItalic, ComputerModernTypeWriterBoldItalic] =- ",UprightFont=cmuntt.ttf,BoldFont=cmuntb.ttf" ++- ",ItalicFont=cmunit.ttf,BoldItalicFont=cmuntx.ttf"+ ",UprightFont=cmuntt,BoldFont=cmuntb" +++ ",ItalicFont=cmunit,BoldItalicFont=cmuntx" midmono i | i `elem` [FreeSerif, FreeSerifBold, FreeSerifBoldItalic, FreeSerifItalic, FreeMono, FreeMonoOblique, FreeMonoBold, FreeMonoBoldOblique] =- ",UprightFont=FreeMono.ttf,BoldFont=FreeMonoBold.ttf," ++- "ItalicFont=FreeMonoOblique.ttf,BoldItalicFont=FreeMonoBoldOblique.ttf"+ ",UprightFont=FreeMono,BoldFont=FreeMonoBold," +++ "ItalicFont=FreeMonoOblique,BoldItalicFont=FreeMonoBoldOblique" midmono _ = ""- ++{-| Takes a FontStyle and returns the LaTeX Command to switch to that font. -}+ fontstyler :: FontStyle -> [Char] fontstyler s = (if (stylebase s) == Mono then "\\ttfamily " else "") ++
src/GetImages.hs view
@@ -1,4 +1,4 @@-+{-| module to download images form the wiki -} module GetImages where import ImperativeState import UrlAnalyse@@ -12,9 +12,7 @@ import Data.List import Tools import System.FilePath-import Control.Concurrent.MVar-import Parallel- + modpath2 :: String -> URL -> URL modpath2 s u = u{url_path =@@ -23,12 +21,12 @@ p = case reverse pp of ('/' : xs) -> (reverse xs) xs -> (reverse xs)- + conv :: URL -> String -> String conv u s = if take 5 s == "http:" then s else- if take 6 s == "https:" then "http:" ++ (drop 6 s) else- if (take 2 s) == "//" then "http:" ++ s else+ if take 6 s == "https:" then "https:" ++ (drop 6 s) else+ if (take 2 s) == "//" then "https:" ++ s else replace2 (exportURL u{url_path =@@ -37,15 +35,15 @@ _ -> s}) "%25" "%"- + getImageUrl2 :: (String, URL) -> Maybe String getImageUrl2 (s, u) = (getImageUrl "fullImageLink" u s) `mplus` (getImageUrl "fullMedia" u s)- + getImageUrl3 :: String -> Maybe String getImageUrl3 s = return s- + getImageUrl :: String -> URL -> String -> Maybe String getImageUrl fi u ss = if isInfixOf fil s then@@ -63,10 +61,12 @@ fil = BStr.unpack (UTF8Str.fromString fi) theHref = BStr.unpack (UTF8Str.fromString "href=\"") q = BStr.unpack (UTF8Str.fromString "\"")- ++{-| downloads a single image form the wiki. It takes the temporary image download directory as first parameter. It takes the WikiUrl of the wiki website currently being processed as second parameter. It takes a tuple as third input parameter. The first element of the tuple is the image number so just an integer that can be used to identify the image uniquely) . The second element of the tupele is image include string of the image from the wiki source, that is the text in between the square brackets as second input parameter. It returns a tuple. The first element of the tuple is a list of urls under which the image may be found on the wiki. The second element of the tuple is the image number as described above. The third element of the tuple is the Url where the description page of the image on the wiki is located -}+ getImagePage :: String ->- WikiUrl -> (Integer, String) -> IO (Maybe ([String], Integer))+ WikiUrl -> (Integer, String) -> IO (Maybe ([String], Integer, URL)) getImagePage dir u (i, ss) = do l <- (mapM (geturl . unify . exportURL . modpath2 ss) (parses u))@@ -76,38 +76,42 @@ let yy = (map go gg) :: [[(URL, String)]] let zz = (listToMaybe (concat yy)) :: Maybe (URL, String) case zz of- Just (_, x) -> do img <- (geturl2 x) :: (IO BStr.ByteString)- BStr.writeFile (dir </> (show i)) img- return- (Just (map (unify . exportURL . (modpath2 ss)) (parses u), i))+ Just (du, x) -> do img <- (geturl2 x) :: (IO BStr.ByteString)+ BStr.writeFile (dir </> (show i)) img+ return+ (Just+ (map (unify . exportURL . (modpath2 ss)) (parses u), i,+ modpath2 ss du)) _ -> return Nothing- where - go :: (URL, Maybe String) -> [(URL, String)]+ where go :: (URL, Maybe String) -> [(URL, String)] go (uu, Just x) = [(uu, x)] go _ = []- ++{-| downloads a single image form the wiki. It takes the temporary image download directory as first parameter. It takes a tuple as second input parameter. The first element of the tuple is the image number so just an integer that can be used to identify the image uniquely) . The second element of the tupele is image include string of the image from the wiki source, that is the text in between the square brackets as second input parameter. It takes the WikiUrl of the wiki websitze currently being processed as thrird parameter. See function getImages in this module for documentation on the returned data type -}+ doImage ::- String ->- WikiUrl ->- (Integer, String) -> IO [Maybe (String, Integer, [String])]+ String -> WikiUrl -> (Integer, String) -> IO (Maybe ImageInfo) doImage dir theWikiUrl img- = do p <- getImagePage dir theWikiUrl (fst img, theName)+ = do myprint (show img)+ p <- getImagePage dir theWikiUrl (fst img, theName) case p of- Just (u, pp) -> return [Just (theName, pp, u)]- _ -> return [Nothing]+ Just (u, pp, du) -> return+ (Just+ ImageInfo{wikiFilename = theName, imageNumber = pp,+ contributorUrls = u, descriptionUrl = du})+ _ -> return Nothing where theName = case dropWhile (/= ':') (takeWhile (/= '|') (snd img)) of- (_ : xs) -> xs+ (_ : xs) -> replace2 xs "%" "%25" _ -> []- ++{-| main function to download images. It takes the temporary image download directory as first parameter. It takes image include strings of the images from the wiki source, that is the text in between the square brackets as second input parameter. It takes the WikiUrl of the wiki websitze currently being processed as thrird parameter. This function runs as a background process. So it returns a list of empty MVars immediately when being called. They are later on filled with information on the downloaded images including their location in the temporary image download directory. The returend MVars contain ImageInfo values. See description in the module ImperativeState for a detailed description. -}+ getImages ::- String ->- [String] ->- WikiUrl ->- ImperativeMonad [MVar [(Maybe (String, Integer, [String]))]]+ String -> [String] -> WikiUrl -> ImperativeMonad [Maybe ImageInfo] getImages dir images theWikiUrl- = liftIO $- do ddir <- base dir- thetheWikiUrl <- base theWikiUrl- iimages <- mapM base ((zip [1 ..] images))- (mapM (liftA3 doImage ddir thetheWikiUrl) iimages)+ = do liftIO $+ do let ddir = dir+ let thetheWikiUrl = theWikiUrl+ let iimages = ((zip [1 ..] images))+ (mapM (doImage ddir thetheWikiUrl) iimages)
src/Hex.hs view
@@ -1,43 +1,58 @@-+{-| module to convert string to hexadecimally endoces strings and vice versa -} module Hex where import Data.Char-import Data.Map hiding (map)+import Data.Map.Strict hiding (map) import Data.Maybe- ++{-| list of integer in the range from 0 to 15. So one hex digit -}+ nums :: [Int] nums = [0 .. 15]- ++{-| list of single digit hex numbers in ascending order -}+ chars :: [Char] chars = (['0' .. '9'] ++ ['A' .. 'F'])- ++{-| map from integer to hex digit -}+ fromm :: Map Int Char fromm = fromList $ zip nums chars- ++{-| map from hex digit to integer -}+ tom :: Map Char Int tom = fromList $ zip chars nums- ++{-| function to convert a single unicode character (Char) to a hex encodes string -}+ hexChar :: Char -> String hexChar c = concat (map (\ i -> fromMaybe ""- ((Data.Map.lookup+ ((Data.Map.Strict.lookup ((if (i == 0) then (ord c) else (ord c) `div` (16 ^ i)) `mod` (16 :: Int)) fromm) >>= (\ x -> return [x]))) (reverse [0 .. 7] :: [Int]))- ++{-| function to convert a string of unicode characters to a hex encoded version of it -}+ hex :: String -> String hex s = concat (map hexChar s)- ++{-| function to decode a hex encoded unicode string -}+ unhex :: String -> String unhex (a : (b : (c : (d : (e : (f : (g : (h : xs)))))))) = (chr (sum (map- (\ (i, cc) -> (16 ^ i) * (fromMaybe 0 (Data.Map.lookup cc tom)))+ (\ (i, cc) ->+ (16 ^ i) * (fromMaybe 0 (Data.Map.Strict.lookup cc tom))) (zip (reverse [0 .. 7] :: [Int]) [a, b, c, d, e, f, g, h])))) : (unhex xs) unhex _ = []
+ src/HtmlRenderer.hs view
@@ -0,0 +1,405 @@++module HtmlRenderer where+import MediaWikiParseTree+import MyState+import qualified Data.Map.Strict as Map+import Data.Map.Strict (Map)+import Control.Monad.Trans.State (State, state, runState, put, get)+import LatexRenderer+import WikiHelper+import Tools+import Data.Char+import Text.Printf+import Babel+import Control.Monad (guard)+import Data.String.HT (trim)+import Data.List.Split+import Text.Highlighting.Kate+import Text.Blaze.Html.Renderer.String+import Data.Tuple+import Data.Hashable+import Hex++type HtmlRenderer = State MyState++templateToHtml :: [Anything Char] -> String -> Renderer String+templateToHtml l s+ = state $+ \ st -> swap $ templateHtmlProcessor st (prepateTemplate l s)++templateHtmlProcessor ::+ MyState ->+ (String, Map String [Anything Char]) -> (MyState, String)+templateHtmlProcessor st+ ("Mathe f\252r Nicht-Freaks: Vorlage:Warnung", ll)+ = (st,+ "<b>Warnung</b><br/>" +++ (treeToHtml (Map.findWithDefault [] "1" ll) st) ++ "")+templateHtmlProcessor st+ ("Mathe f\252r Nicht-Freaks: Vorlage:Hinweis", ll)+ = (st,+ "<b>Hinweis</b><br/>" +++ (treeToHtml (Map.findWithDefault [] "1" ll) st) ++ "")+templateHtmlProcessor st+ ("Mathe f\252r Nicht-Freaks: Vorlage:Beispiel", ll)+ = (st,+ "<b>Beispiel</b><br/>" +++ (treeToHtml (Map.findWithDefault [] "beispiel" ll) st) ++ "")+templateHtmlProcessor st+ ("Mathe f\252r Nicht-Freaks: Vorlage:Satz", ll)+ = (st,+ "<b>Satz</b><br/>" +++ (treeToHtml (Map.findWithDefault [] "satz" ll) st) ++ "")+templateHtmlProcessor st+ ("Mathe f\252r Nicht-Freaks: Vorlage:L\246sungsweg", ll)+ = (st,+ "<b>Wie kommt man auf den Beweis?</b>" +++ (treeToHtml (Map.findWithDefault [] "l\246sungsweg" ll) st) ++ "")+templateHtmlProcessor st+ ("Mathe f\252r Nicht-Freaks: Vorlage:Beweis", ll)+ = (st,+ "<b>Beweis: </b><br/>" +++ (treeToHtml (Map.findWithDefault [] "beweis" ll) st) ++ "")+templateHtmlProcessor st+ ("Mathe f\252r Nicht-Freaks: Vorlage:Definition", ll)+ = (st,+ "<b>Definition: </b><i>(" +++ (treeToHtml (Map.findWithDefault [] "titel" ll) st) +++ ")</i><br/>" +++ (treeToHtml (Map.findWithDefault [] "definition" ll) st))+templateHtmlProcessor st+ ("mathe f\252r Nicht-Freaks: Vorlage:Definition", ll)+ = (st,+ "<b>Definition: </b><i>(" +++ (treeToHtml (Map.findWithDefault [] "titel" ll) st) +++ ")</i><br/>" +++ (treeToHtml (Map.findWithDefault [] "definition" ll) st))+templateHtmlProcessor st ("-", ll)+ = (tempProcAdapter $ mnfindent ll) st+templateHtmlProcessor st+ ("Mathe f\252r Nicht-Freaks: Vorlage:Klapptext", ll)+ = (tempProcAdapter $ mnfklapptext ll) st+templateHtmlProcessor st+ ("Aufgabensammlung: Vorlage:Klapptext", ll)+ = (tempProcAdapter $ mnfklapptext ll) st+templateHtmlProcessor st+ ("Aufgabensammlung: Vorlage:Vollst\228ndige Induktion", ll)+ = (tempProcAdapter $ mnfinduktion ll) st+templateHtmlProcessor st ("Formel", ll)+ = (st,+ "<dl><dd>" +++ (treeToHtml (Map.findWithDefault [] "1" ll) st) ++ "</dd></dl>")+templateHtmlProcessor st+ ("Mathe f\252r Nicht-Freaks: Vorlage:Frage", ll)+ = (tempProcAdapter $ mnffrage ll) st+templateHtmlProcessor st ("Anker", _) = (st, "")+templateHtmlProcessor st ("Symbol", ll)+ = (st, (treeToHtml (Map.findWithDefault [] "1" ll) st))+templateHtmlProcessor st+ ("#invoke:Mathe f\252r Nicht-Freaks/Seite", _) = (st, "")+templateHtmlProcessor st ("Aufgabensammlung: Vorlage:Infobox", _)+ = (st, "")+templateHtmlProcessor st ("Aufgabensammlung: Vorlage:Symbol", _)+ = (st, "")+templateHtmlProcessor st ("Nicht l\246schen", _) = (st, "")+templateHtmlProcessor st ("#ifeq:{{{include", _) = (st, "")+templateHtmlProcessor st ("Druckversion Titelseite", _) = (st, "")+templateHtmlProcessor st ("PDF-Version Gliederung", _) = (st, "")+templateHtmlProcessor st ("#invoke:Liste", _) = (st, "")+templateHtmlProcessor st ("Smiley", _) = (st, "\9786")+templateHtmlProcessor st ("", _) = (st, "")+templateHtmlProcessor st (x, _)+ = (st, "UNKNOWN TEMPLATE " ++ x ++ " ")++wikiLinkCaptionHtml :: [Anything Char] -> MyState -> String+wikiLinkCaptionHtml l st = if isCaption x then rebuild x else ""+ where x = (treeToHtml (last (splitOn [C '|'] l)) st)+ rebuild (':' : xs) = xs+ rebuild b = b++wikiImageToHtml :: [Anything Char] -> Renderer String+wikiImageToHtml l+ = do st <- get+ mystr <- return+ ((if not (micro st) then "<p>" else "") +++ "<" +++ (if ext == "webm" then "video controls" else "img") +++ " src=\"./images/" +++ (n st) +++ "." +++ ext +++ "\" style=\"width: " +++ (if (tb st) then "100.0" else (mysize st)) +++ "%;\">" +++ (if (not (micro st)) then+ "<br/> " +++ (getfig st) ++ " " ++ (n st) ++ " " ++ (s st) ++ "</p>"+ else ""))+ put+ st{getImages = (getImages st) ++ [shallowFlatten l],+ getJ = ((getJ st) + 1)}+ return mystr+ where ext+ = normalizeExtensionHtml+ (map toLower+ (fileNameToExtension (headSplitEq '|' (shallowFlatten l))))+ s st+ = if (trim (s1 st)) `elem` ["verweis=", "alt=", "link="] then ""+ else (s1 st)+ s2 st+ = case Map.lookup "alt" (snd (prepateTemplate l "x")) of+ Just xx -> wikiLinkCaptionHtml xx st+ Nothing -> wikiLinkCaptionHtml l st+ s1 st+ = if '|' `elem` (shallowFlatten l) then (s2 st) else+ (treeToHtml [] st{getJ = ((getJ st) + 1)})+ mysize st = printf "%0.5f" ((mysizefloat2 st) * 100.0)+ mysizefloat st = (min (getF st) (imageSize l))+ mysizefloat2 st = if (msb st) then 1.0 else (mysizefloat st)+ msb st = (mysizefloat st) == (getF st)+ micro st = ((mysizefloat st) < 0.17) || ((getInTab st) > 1)+ n st = show (getJ st)+ tb st = ((getInTab st) > 0)+ getfig st+ = head+ (splitOn "}"+ (last+ (splitOn "\\newcommand{\\myfigurebabel}{"+ (makeBabel (langu st) "en"))))++galleryContentToHtml :: [[Anything Char]] -> Renderer String+galleryContentToHtml (x : xs)+ = do s <- galleryRowToHtml x+ ss <- galleryContentToHtml xs+ return $ s ++ "</tr><tr>" ++ ss+galleryContentToHtml [] = return []++{-| converts a part of a gallery (image gallery, gallery tag) from parse tree to latex. A part are as many elements as fit into a single row in the resulting latex table -}++galleryRowToHtml :: [Anything Char] -> Renderer String+galleryRowToHtml [] = return []+galleryRowToHtml (x : []) = treeToHtml2 [x]+galleryRowToHtml (x : xs)+ = do s <- treeToHtml2 [x]+ g <- galleryRowToHtml xs+ return $ s ++ "</td><td>" ++ g++{-| Converts are gallery (image gallery, gallery tag) from parse tree to latex. Also writes table header and footer. This is the function you should use for converting galleries to latex -}++galleryToHtml :: [Anything Char] -> Renderer String+galleryToHtml x+ = do st <- get+ put st{getF = (getF st) * galleryTableScale}+ s <- (galleryContentToHtml+ [z | z <- splitToTuples [y | y <- x, isWikiLink y],+ trim (treeToHtml z st) /= ""])+ st2 <- get+ put st2{getF = (getF st)}+ return ("<table><tr>" ++ s ++ "</tr></table>")++mnffrage :: Map String [Anything Char] -> Renderer String+mnffrage ll+ = do typ <- treeToHtml2 (Map.findWithDefault [] "typ" ll)+ frage <- treeToHtml2 (Map.findWithDefault [] "frage" ll)+ antwort <- treeToHtml2 (Map.findWithDefault [] "antwort" ll)+ return+ ("<dl><dd><b>" +++ typ ++ ":</b> " ++ frage ++ "</dd><dd>" ++ antwort ++ "</dd></dl>")++mnfindent :: Map String [Anything Char] -> Renderer String+mnfindent ll+ = do one <- treeToHtml2 (Map.findWithDefault [] "1" ll)+ return ("<dl><dd>" ++ one ++ "</dd></dl>")++mnfklapptext :: Map String [Anything Char] -> Renderer String+mnfklapptext ll+ = do kopf <- treeToHtml2 (Map.findWithDefault [] "kopf" ll)+ inhalt <- treeToHtml2 (Map.findWithDefault [] "inhalt" ll)+ return ("<b>" ++ kopf ++ "</b><br/>" ++ inhalt)++mnfinduktion :: Map String [Anything Char] -> Renderer String+mnfinduktion ll+ = do erf <- treeToHtml2+ (Map.findWithDefault [] "erfuellungsmenge" ll)+ aus <- treeToHtml2 (Map.findWithDefault [] "aussageform" ll)+ anf <- treeToHtml2 (Map.findWithDefault [] "induktionsanfang" ll)+ vor <- treeToHtml2+ (Map.findWithDefault [] "induktionsvoraussetzung" ll)+ beh <- treeToHtml2+ (Map.findWithDefault [] "induktionsbehauptung" ll)+ sch <- treeToHtml2+ (Map.findWithDefault [] "beweis_induktionsschritt" ll)+ return+ ("<b>Aussageform, deren Allgemeing\252ltigkeit f\252r " +++ erf +++ " bewiesen werden soll:</b><br/>" +++ aus +++ "<br/><b>1. Induktionsanfang</b><br/>" +++ anf +++ "<br/><b>2. Induktionsschritt</b><br><b>2a. Induktionsvoraussetzung</b><br/>"+ +++ vor +++ "<br/><b>2b. Induktionsbehauptung</b><br/>" +++ beh +++ "<br/><b>2c. Beweis des Induktionsschritts</b><br/>" +++ sch ++ "<br/>")++writedict :: [(String, String)] -> String+writedict [] = []+writedict ((k, v) : xs)+ = k ++ "=\"" ++ v ++ "\" " ++ (writedict xs)++treeToHtml3 ::+ Map String Int ->+ Maybe String ->+ String -> [Anything Char] -> MyState -> (String, MyState)+treeToHtml3 formulas mylanguage title l st+ = let (a, b)+ = runState (treeToHtml2 l) st{langu = mylanguage, forms = formulas}+ in+ ("<html><head><meta charset=\"utf-8\"><title>" +++ title +++ "</title><style>table.sourceCode, tr.sourceCode, td.lineNumbers, td.sourceCode { margin: 0; padding: 0; vertical-align: baseline; border: none; }\ntable.sourceCode { width: 100%; line-height: 100%; }\ntd.lineNumbers { text-align: right; padding-right: 4px; padding-left: 4px; }\ntd.sourceCode { padding-left: 5px; }\ncode > span.kw { font-weight: bold; }\ncode > span.dt { text-decoration: underline; }\ncode > span.co { font-style: italic; }\ncode > span.al { font-weight: bold; }\ncode > span.er { font-weight: bold; }\n</style></head><body>"+ ++ a,+ b)++treeToHtml :: [Anything Char] -> MyState -> String+treeToHtml l states = (fst $ runState (treeToHtml2 l) states)++treeToHtmlBak :: [Anything Char] -> MyState -> String+treeToHtmlBak _ _ = ""++treeToHtml2Bak :: [Anything Char] -> HtmlRenderer String+treeToHtml2Bak _ = return ""++treeToHtml2 :: [Anything Char] -> HtmlRenderer String+treeToHtml2 ll+ = do x <- allinfo+ return $ concat x+ where allinfo :: HtmlRenderer [String]+ allinfo = mapM nodeToHtml ll+ + walk :: String -> [Anything Char] -> String -> HtmlRenderer String+ walk prefix l postfix+ = do d <- treeToHtml2 l+ return $ prefix ++ d ++ postfix+ + nodeToHtml :: Anything Char -> HtmlRenderer String+ nodeToHtml (C c)+ = do st <- get+ x <- if (c == '\n') && ((lastChar st) == c) then return "</p><p>"+ else return [c]+ put st{lastChar = c}+ return x+ nodeToHtml (Environment Wikilink _ l)+ = do st <- get+ if getInHeading st then return $ wikiLinkCaption l st else+ if (isImage (shallowFlatten l)) then wikiImageToHtml l else+ return $ wikiLinkCaption l st+ nodeToHtml (Environment Tag (TagAttr "br" _) _) = return "<br/>"+ nodeToHtml (Environment Tag (TagAttr "script" _) _) = return []+ nodeToHtml (Environment Source (TagAttr _ a) l)+ = do let g = case reverse l of+ [] -> []+ (x : xs) -> if x == (C '\n') then reverse xs else l+ let f = shallowFlatten (map renormalize (breakLines3 linewidth l))+ d <- treeToHtml2 (breakLines3 linewidth g)+ st <- get+ return $+ case+ do aa <- Map.lookup "lang" a+ guard (not (getInFootnote st))+ guard (not ((getInTab st) > 0))+ return aa+ of+ Just j -> (renderHtml+ ((formatHtmlBlock defaultFormatOpts) (highlightAs j f)))+ Nothing -> (rtrim d)+ nodeToHtml (Environment Template (Str s) l) = templateToHtml l s+ nodeToHtml (Environment Wikitable _ l)+ = walk "<table><tr>" l "</table></tr>"+ nodeToHtml (Environment TableRowSep _ _) = return "</tr><tr>"+ nodeToHtml (Environment TableColSep _ _) = return "</td><td>"+ nodeToHtml (Environment TableHeadColSep _ _) = return "</th><th>"+ nodeToHtml (Environment TableCap _ l)+ = walk "<caption>" l "</caption>"+ nodeToHtml (Environment Wikiheading (Str x) l)+ = let y = (show (length x)) in+ walk ("<h" ++ y ++ ">") l ("</h" ++ y ++ ">")+ nodeToHtml (Environment ItemEnv (Str _) [Item _]) = return []+ nodeToHtml (Environment ItemEnv (Str s) l)+ = do tag <- return+ (case s of+ "*" -> "ul"+ _ -> "ol")+ walk ("<" ++ tag ++ ">") l ("</li></" ++ tag ++ ">")+ nodeToHtml (Item _) = return "</li><li>"+ nodeToHtml (Environment Tag (TagAttr "noscript" _) _) = return []+ nodeToHtml (Environment Tag (TagAttr "head" _) _) = return []+ nodeToHtml (Environment Tag (TagAttr "a" _) l) = walk "" l ""+ nodeToHtml (Environment Tag (TagAttr "body" _) l) = walk "" l ""+ nodeToHtml (Environment Tag (TagAttr "html" _) l) = walk "" l ""+ nodeToHtml (Environment Tag (TagAttr "div" a) l)+ = if (Map.member "class" a) then+ if+ ((Map.findWithDefault [] "class" a) `elem`+ ["noprint", "latitude", "longitude", "elevation"])+ || ((Map.findWithDefault [] "id" a) `elem` ["coordinates"])+ then return "" else walk "" l ""+ else walk "" l ""+ nodeToHtml (Environment Tag (TagAttr "img" m) _)+ | (Map.lookup "class" m) == (Just "mwe-math-fallback-image-inline")+ = return []+ nodeToHtml (Environment Comment _ _) = return []+ nodeToHtml (Environment Preformat (TagAttr "pre" _) l)+ = walk "<pre>" l "</pre>"+ nodeToHtml (Environment Math (TagAttr "math" _) l)+ = do st <- get+ return+ ("<img src=\"./formulas/" +++ (hex (show (hash (mathTransform l)))) +++ ".png\" style=\" width:" +++ (show+ ((((forms st) Map.!+ ((hex (show (hash (mathTransform l)))) ++ ".png"))+ * 2)+ `div` 3))+ ++ "px;\" />")+ nodeToHtml (Environment Math _ l)+ = do st <- get+ return+ ("<img src=\"./formulas/" +++ (hex (show (hash (mathTransform l)))) +++ ".png\" style=\" width:" +++ (show+ ((((forms st) Map.!+ ((hex (show (hash (mathTransform l)))) ++ ".png"))+ * 2)+ `div` 3))+ ++ "px;\" />")+ nodeToHtml (Environment Tag (TagAttr "table" m) l)+ = do st <- get+ put $ st{getInTab = (getInTab st) + 1}+ d <- walk ("<table " ++ (writedict (Map.toList m)) ++ ">") l+ ("</table>")+ st2 <- get+ put $ st2{getInTab = (getInTab st)}+ return d+ nodeToHtml (Environment Gallery _ l)+ = do st <- get+ put st{getInGallery = True}+ d <- galleryToHtml l+ st2 <- get+ put $ (newst st2){getInGallery = (getInGallery st)}+ return d+ where midst i = i{getInGallery = False}+ gins i = generateGalleryImageNumbers i (midst i)+ newst i+ = (midst i){getGalleryNumbers =+ (getGalleryNumbers (midst i)) ++ (map toInteger (gins i))}+ nodeToHtml (Environment Tag (TagAttr "span" _) l) = walk "" l ""+ nodeToHtml (Environment Tag (TagAttr x m) l)+ = walk ("<" ++ x ++ " " ++ (writedict (Map.toList m)) ++ ">") l+ ("</" ++ x ++ ">")+ nodeToHtml (Environment _ _ l) = walk "" l ""+ nodeToHtml _ = return []
src/ImperativeState.hs view
@@ -1,26 +1,34 @@-+{-| module defining the datatypes needed for the outer imperative flow control of the program. All configurtion information needed for single run of the program is stored here. -} module ImperativeState where-import Data.Map+import Data.Map.Strict import Control.Monad.State-import Control.Monad.Error+import Control.Monad.Except+import MediaWikiParseTree import UrlAnalyse import Control.Concurrent.MVar import Data.List- +import Network.URL++{-| A type to for errors that might be thrown during the imperative calculation -}+ data MyError = DownloadError String String | OtherError String | WikiUrlParseError String | NotImplementedError | NotExcatlyOneError String | NotIntegerError String+ | NotIntegerPairError String | NotAtMostOneError String | ToManyOptionsError+ | ToManyOutputOptionsError | PaperError- -instance Error MyError where- noMsg = OtherError "A String Error!"- strMsg s = OtherError s- ++{-| A monad for dealing with errors -}++type MyErrorMonad = Either MyError++{-| printable error messages -}+ instance Show MyError where show (DownloadError theLemma theUrl) = "Error downloading the lemma \"" ++@@ -29,10 +37,15 @@ = "Error: The supplied url " ++ theUrl ++ " could not be parsed" show NotImplementedError = "Error: The requested feature is not implemented yet"+ show (NotIntegerPairError msg)+ = "Error: The option --" +++ msg ++ "could not be parsed to a pair of integers (like -f 23:42)" show PaperError = "Error: The option paper may only be one of A4,A5,B5,letter,legal,executive" show ToManyOptionsError = "Error: at most one of the options --internal --templates --message --html may be given"+ show ToManyOutputOptionsError+ = "Error: at most one of the options --zip --epub --odt may be given" show (NotExcatlyOneError msg) = "Error: The option --" ++ msg ++ " has to be present exactly once in the command line"@@ -43,40 +56,77 @@ = "Error: The option --" ++ msg ++ " could not be parsed as an integer." show (OtherError msg) = msg- +++{-| A type to capture a contributor form the list of contributors needed for license reasons. The element name is username of the author, the element edits is the number of edits done by the user, href is a link to the users homepage on the wiki -}+ data Contributor = Contributor{name :: String, edits :: Integer, href :: String} deriving (Eq, Ord, Show, Read)- ++{-| The sum of two contribors is defined as the new contribor with the same name and homepage and the edits summed up. Of course this makes only sense when summing up edits for the same contributor, which is not checked but has to be ensured by hand -}+ myplus :: Contributor -> Contributor -> Contributor myplus x y = x{edits = (edits x) + (edits y)}- ++{-| Build a map of contributors summing up the edits per contributor. The map takes the name of the contributor as key and the contributor records given above as value. The first parameter is a list of such maps the results is also such a map representing the sum of the maps in the list -}+ contribsum :: [Map String Contributor] -> Map String Contributor-contribsum x = Data.List.foldl (unionWith myplus) Data.Map.empty x- -imperativeStateZero :: ImperativeState+contribsum x+ = Data.List.foldl (unionWith myplus) Data.Map.Strict.empty x++{-| a defaults version of the record Imperative State -}+++imperativeStateZero :: IO ImperativeState imperativeStateZero- = ImperativeState{audict = [], fullUrl = fullWikiUrlZero,- tmpPath = ""}- + = do v <- newMVar (0 :: Int)+ return+ ImperativeState{audict = [], fullUrl = fullWikiUrlZero,+ tmpPath = "", counter = v, loadacu = []}+ data ImperativeState = ImperativeState{audict ::- [MVar (Map String Contributor)],- fullUrl :: FullWikiUrl, tmpPath :: String}- -type ImperativeMonad = ErrorT MyError (StateT ImperativeState IO)- + [(Map String Contributor)],+ fullUrl :: FullWikiUrl, tmpPath :: String,+ counter :: MVar Int, loadacu :: [Anything Char]}++data ImageInfo = ImageInfo{wikiFilename :: String,+ imageNumber :: Integer, contributorUrls :: [String],+ descriptionUrl :: URL}+ deriving (Show, Read)++type ImperativeMonad = ExceptT MyError (StateT ImperativeState IO)+ data RunMode = HTML | ExpandedTemplates | StandardTemplates+ | Book | UserTemplateFile String- deriving (Show, Read)- + deriving (Show, Read, Eq)+ data SourceMode = Included | Excluded deriving (Show, Read)- -data FullConfig = FullConfig{resolution :: Integer,- outputFilename :: String, inputUrl :: String, runMode :: RunMode,- paper :: String, vector :: Bool, copy :: Maybe String,- mainPath :: String, server :: Maybe Int}++data OutputType = PlainPDF+ | ZipArchive+ | EPubFile+ | OdtFile+ deriving (Show, Read, Eq)++data FullConfig = FullConfig{headers :: Maybe String,+ resolution :: Integer, outputFilename :: String,+ inputUrl :: String, runMode :: RunMode, paper :: String,+ vector :: Bool, copy :: Maybe String, mainPath :: String,+ server :: Maybe Int, outputType :: OutputType,+ selfTest :: Maybe (Integer, Integer), compile :: Maybe String,+ imgctrb :: Maybe String} deriving (Show, Read)++fullconfigbase :: FullConfig+fullconfigbase+ = FullConfig{headers = Nothing, resolution = 0,+ outputFilename = "", inputUrl = "", runMode = HTML, paper = "A4",+ vector = False, copy = Nothing, mainPath = "", server = Nothing,+ outputType = PlainPDF, selfTest = Nothing, compile = Nothing,+ imgctrb = Nothing}
− src/Join.hs
@@ -1,11 +0,0 @@--module Join where-import ImperativeState-import Static-import Data.ByteString.UTF8- -join :: String -> String -> ImperativeMonad String-join body listOfFiguers- = return- ((toString (latexHeader)) ++- body ++ listOfFiguers ++ (toString latexFooter))
src/LatexRenderer.hs view
@@ -1,2729 +1,2994 @@-{-DHUN| This modules converts the parse tree to a latex document DHUN-}-module LatexRenderer- (treeToLaTeX3, shallowFlatten, prepateTemplate, replace, doUnicode,- getGalleryNumbers, getTitle, initialState, getJ, urld,- analyseNetloc, templateMap, getUserTemplateMap, urls, mUrlState,- initialUrlState, makeLables, templateRegistry, baseUrl,- deepFlatten)- where-import Data.String.HT (trim)-import MyState-import Data.List-import qualified Data.Map as Map-import Data.Map (Map)-import Data.Char-import Text.Printf-import FontTool-import MediaWikiParseTree-import MagicStrings-import Tools-import Control.Monad.Trans.State- (State, state, runState, StateT, runStateT, put, get)-import Control.Monad.Trans.Class (lift)-import Control.Monad (guard, mplus, msum)-import TableHelper-import GHC.Float-import Text.Highlighting.Kate-import WikiLinkHelper-import WikiHelper-import Data.List.Split-import BaseFont-import Data.Maybe-import Data.Tuple (swap)- -{-DHUN| flattens a part of the parse tree, that is takes the characters found in the tree and turns them into a string dropping all other information in the tree DHUN-}- -deepFlatten :: [Anything t] -> [Anything t]-deepFlatten ll = concat $ map go ll- where go (Environment _ _ l) = (deepFlatten l)- go x = [x]- -{-DHUN| the maximum width of lines for preformat and source code DHUN-}- -linewidth :: Int-linewidth = 80- -{-DHUN| The user can provide her own translation table for mediawiki templates to latex commands. this is done in the templates.user files. This function takes this file in list representation and converts it to the map representation to be able to look up the names of templates DHUN-}- -getUserTemplateMap :: [[String]] -> Map String [String]-getUserTemplateMap input- = Map.fromList (map (\ (x : xs) -> (x, xs)) input)- -{-DHUN| table may omit tailing columns in a row, but in latex they need to be written out, this function does so DHUN-}- -rowaddsym :: TableState -> [Char]-rowaddsym st- = if (currentColumn st) < ((numberOfColumnsInTable st) + 1) then- (if (currentColumn st) == 1 then- replicate (((numberOfColumnsInTable st)) - (currentColumn st)) '&'- else- replicate (((numberOfColumnsInTable st) + 1) - (currentColumn st))- '&')- else []- -{-DHUN| This function renders the inner parts of a table to latex it does so by calling tableContentToLaTeX and additionally removes superfluous newlines which might cause compilation problems in latex when used inside tables DHUN-}- -tableContentToLaTeX2 ::- [Anything Char] -> (StateT TableState (State MyState) String)-tableContentToLaTeX2 l- = do r <- tableContentToLaTeX l- return (killnl2 r)- -{-DHUN| This function renders the inner parts of a table to latex, please always use tableContentToLaTeX2 since this also removes superfluous newlines DHUN-}- -tableContentToLaTeX ::- [Anything Char] -> (StateT TableState (State MyState) String)-tableContentToLaTeX ((Environment TableRowSep _ _) : [])- = do st <- get- let cc = (currentColumn st)- let c = cc + (multiRowCount cc (multiRowMap st))- return $- (headendsym (lastCellWasHeaderCell st)) ++- (multiColumnEndSymbol (lastCellWasMultiColumn st)) ++- (rowaddsym st{currentColumn = c})-tableContentToLaTeX ((Environment TableRowSep _ l) : xs)- = do sst <- lift get- st <- get- let cc = (currentColumn st)- let c = cc + (multiRowCount cc (multiRowMap st))- let mycond- = (not (currentRowIsHeaderRow st)) &&- (stillInTableHeader st) &&- (lastRowHadEmptyMultiRowMap st) && (not (isFirstRow st))- put- (st{rowCounter = 1 + (rowCounter st),- outputTableHasHeaderRows =- (outputTableHasHeaderRows st) || (currentRowIsHeaderRow st),- lastRowHadEmptyMultiRowMap = (myempty (multiRowMap st))})- st2 <- get- put- st2{outputLastRowOfHeader =- (if mycond then rowCounter st2 else outputLastRowOfHeader st2)}- st3 <- get- put- st3{lastCellWasNotFirstCellOfRow = False,- lastCellWasMultiColumn = False, currentColumn = 1,- multiRowMap =- multiRowDictChange (currentColumn st) (multiRowMap st) l,- lastCellWasMultiRow = False, isFirstRow = False,- lastCellWasHeaderCell = False, currentRowIsHeaderRow = False,- stillInTableHeader =- if stillInTableHeader st then not mycond else False}- xx <- tableContentToLaTeX xs- return $- if (not (isFirstRow st)) then- (headendsym (lastCellWasHeaderCell st)) ++- (multiColumnEndSymbol (lastCellWasMultiColumn st)) ++- (multiRowEndSymbol (lastCellWasMultiRow st)) ++- (multiRowSymbolForRowSep (currentColumn st) (multiRowMap st)- (seperatingLinesRequestedForTable st))- ++- (rowaddsym st{currentColumn = c}) ++- (rowendsymb ((getInTab sst) <= 1)- ((rowCounter st) == (inputLastRowOfHeader st) - 2))- ++- (innerHorizontalLine (seperatingLinesRequestedForTable st)- (multiRowMap st3)- (numberOfColumnsInTable st))- ++ " \n" ++ xx- else xx-tableContentToLaTeX ((Environment TableColSep _ l) : xs)- = do st <- get- let cc = (currentColumn st)- let c = cc + (multiRowCount cc (multiRowMap st))- put- st{lastCellWasNotFirstCellOfRow = True,- lastCellWasMultiColumn =- ("" /=- (multiColumnStartSymbol l (columnsWidthList st) c- (seperatingLinesRequestedForTable st)- st)),- currentColumn = (c + (columnMultiplicityForCounting l)),- multiRowMap =- multiRowDictChange (currentColumn st) (multiRowMap st) l,- lastCellWasMultiRow =- (multiRowStartSymbol l (activeColumn st)) /= "",- isFirstRow = False, lastCellWasHeaderCell = False}- xx <- tableContentToLaTeX xxs- return $- (headendsym (lastCellWasHeaderCell st)) ++- (multiColumnEndSymbol (lastCellWasMultiColumn st)) ++- (multiRowEndSymbol (lastCellWasMultiRow st)) ++- (columnSeperator (lastCellWasNotFirstCellOfRow st)) ++- (multiRowSymbol (currentColumn st) (multiRowMap st)- (seperatingLinesRequestedForTable st))- ++- (multiColumnStartSymbol l (columnsWidthList st) c- (seperatingLinesRequestedForTable st)- st)- ++- (multiRowStartSymbol l (activeColumn st)) ++- (if rig then "\\RaggedLeft{}" else "") ++- (tablecolorsym l) ++ hypennothing ++ xx- where rig- = isInfixOf2- [Environment Attribute (Attr ("style", "text-align:right")) []]- l- xxs- = if rig then (reverse . removesp . reverse . removesp) xs else xs- removesp (C ' ' : as) = removesp as- removesp a = a-tableContentToLaTeX ((Environment TableHeadColSep _ l) : xs)- = do st <- get- let cc = currentColumn st- let c = cc + (multiRowCount cc (multiRowMap st))- put- st{lastCellWasNotFirstCellOfRow = True,- lastCellWasMultiColumn =- ("" /=- (multiColumnStartSymbol l (columnsWidthList st) c- (seperatingLinesRequestedForTable st)- st)),- currentColumn = (c + (columnMultiplicityForCounting l)),- multiRowMap =- multiRowDictChange (currentColumn st) (multiRowMap st) l,- lastCellWasMultiRow =- multiRowStartSymbol l (activeColumn st) /= "",- isFirstRow = False, lastCellWasHeaderCell = True,- currentRowIsHeaderRow = True}- xx <- tableContentToLaTeX xs- return $- (headendsym (lastCellWasHeaderCell st)) ++- (multiColumnEndSymbol (lastCellWasMultiColumn st)) ++- (multiRowEndSymbol (lastCellWasMultiRow st)) ++- (columnSeperator (lastCellWasNotFirstCellOfRow st)) ++- (multiRowSymbol (currentColumn st) (multiRowMap st)- (seperatingLinesRequestedForTable st))- ++- (multiColumnStartSymbol l (columnsWidthList st) c- (seperatingLinesRequestedForTable st)- st)- ++- (multiRowStartSymbol l (activeColumn st)) ++- headstartsym ++ (tablecolorsym l) ++ hypennothing ++ xx-tableContentToLaTeX (x : xs)- = do st <- get- ele <- case (activeColumn st) of- Just n | (n /= fromIntegral (currentColumn st)) ||- (lastCellWasMultiColumn st)- -> return []- _ -> lift $ treeToLaTeX2 [x]- xx <- tableContentToLaTeX xs- return $ ele ++ xx-tableContentToLaTeX []- = do st <- get- return $- (headendsym (lastCellWasHeaderCell st)) ++- (multiColumnEndSymbol (lastCellWasMultiColumn st)) ++- (multiRowSymbolForTableEnd (currentColumn st) (multiRowMap st)- (seperatingLinesRequestedForTable st))- ++ (multiRowEndSymbol (lastCellWasMultiRow st)) ++ (rowaddsym st)- -{-DHUN| This string has to be added to each new cell in a latex table in order to allow for hyphenation of the first word in this cell DHUN-}- -hypennothing :: [Char]-hypennothing = "\\hspace*{0pt}\\ignorespaces{}\\hspace*{0pt}"- -{-DHUN| color cell in latex if HTML attribute bgcolor is present in the parse tree for the cell DHUN-}- -tablecolorsym :: [Anything Char] -> [Char]-tablecolorsym ll- = case genLookup "bgcolor" ll of- Just x -> case x of- ('#' : ys) -> let (p, colname, col) = colinfo ('l' : 'l' : ys) in- if p then "\\cellcolor[rgb]" ++ col else- "\\cellcolor{" ++ colname ++ "}"- _ -> "\\cellcolor{" ++ x ++ "}"- Nothing -> ""- -{-DHUN| the caption of a table is given in |+ or <th> elements, it needs to be reformatted in the parse in oder to be rendered in latex as a multicolumn cell spanning the whole width of the table DHUN-}- -reformatTableCaption ::- Int -> [Anything Char] -> MyState -> [Anything Char]-reformatTableCaption n- ((Environment TableCap _ l) : ((Environment TableRowSep a b) : xs))- st- = if (filter (not . isSpace) (treeToLaTeX l st)) == [] then- reformatTableCaption n xs st else- (Environment TableRowSep (Str "") []) :- ((Environment TableHeadColSep (Str "")- [Environment Attribute (Attr ("colspan", (show n))) []])- : l)- ++ [(Environment TableRowSep a b)] ++ reformatTableCaption n xs st-reformatTableCaption n ((Environment TableCap _ l) : xs) st- = if (filter (not . isSpace) (treeToLaTeX l st)) == [] then- reformatTableCaption n xs st else- (Environment TableRowSep (Str "") []) :- ((Environment TableHeadColSep (Str "")- [Environment Attribute (Attr ("colspan", (show n))) []])- : l)- ++- [(Environment TableRowSep (Str "") [])] ++- reformatTableCaption n xs st-reformatTableCaption n (x : xs) st- = x : reformatTableCaption n xs st-reformatTableCaption _ [] _ = []- -{-DHUN| strips column separators out of a parse tree or part of which DHUN-}- -stripColSep :: [Anything Char] -> [Anything Char]-stripColSep = filter go- where go (Environment TableHeadColSep _ _) = False- go (Environment TableColSep _ _) = False- go _ = True- -{-DHUN| predicate to test if an element in the parse tree is a row separator DHUN-}- -isRowSep :: Anything Char -> Bool-isRowSep (Environment TableRowSep _ _) = True-isRowSep _ = False- -{-DHUN| strip empty rows out of the parse tree DHUN-}- -stripempty :: [Anything Char] -> MyState -> [Anything Char]-stripempty [] _ = []-stripempty ((Environment TableRowSep a b) : xs) s- = (Environment TableRowSep a b) : (stripempty xs s)-stripempty l s- = if pred2 then (stripempty post2 s) else- pre ++ (stripempty (post3 post) s)- where post2- = case post of- (x : xs) -> if isRowSep x then xs else post- [] -> post- post3 o- = case o of- (x : (y : xs)) -> if (isRowSep x) && (isRowSep y) then- post3 (y : xs) else (x : y : xs)- x -> x- pred2 = and (map (`elem` [' ', '\r', '\n']) inside)- pre = takeWhile (not . isRowSep) l- post = dropWhile (not . isRowSep) l- inside = (treeToLaTeX (stripColSep pre)) s- -{-DHUN| In order to determine the maximum width of columns, each table is precompiled with latex several times, with only one column included each time. this function creates the list of the latex sources of these tables, for one table in the parse tree DHUN-}- -maketablist ::- [Anything Char] -> TableState -> Int -> MyState -> [[Char]]-maketablist l tst nc mst = map tablo [1 .. (nc + 1)]- where tablo n- = "\\begin{tabular}{|" ++- (replicate nc 'l') ++- "|}" ++- (fst- (fst- (runState- ((runStateT (tableContentToLaTeX2 l))- tst{inputLastRowOfHeader = -2, activeColumn = Just n})- mst)))- ++ "\\end{tabular}"- -{-DHUN| Takes a map from int to double finds the biggest double and removes the corresponding key value pair from the map. This way wide columns are set to smaller sizes in order to fit the whole table onto the page width DHUN-}- -removehighest :: Map Int Double -> Map Int Double-removehighest m- | m /= Map.empty = Map.fromList (hlp (Map.toList m))- where mx = maximum (Map.elems m)- hlp ((_, v) : xs) | v == mx = xs- hlp (x : xs) = x : (hlp xs)- hlp [] = []-removehighest _ = Map.empty- -{-DHUN| Returns a list of floats which represents the width of the columns of a table in units of the line width with the proper corrections for use in the a latex documents. If the boolean input parameter is true the table is understood to be written in landscape mode. It also take a map of Int to Double. This is the list of the maximum width of columns determined by previous runs of latex on the table with only one column included per run DHUN-}- -wdth3 :: Bool -> Map Int Double -> [Float]-wdth3 ls m- | m /= Map.empty =- (map- ((* (1.0 - (scalefactor (fromIntegral n)))) .- double2Float . (/ (linew2 ls)))- (Map.elems mm))- where n = (maximum (Map.keys m))- mm = wdth ls n m-wdth3 _ _ = []- -{-DHUN| Returns a table header which represents the width of the columns of a table in units of the line width with the proper corrections for use in the a latex documents. If the first boolean input parameter is true the table is understood to be written in landscape mode. It also take a map of Int to Double. This is the list of the maximum width of columns determined by previous runs of latex on the table with only one column included per run. If second boolean parameter is true it is understood the the rule should be printed with the table, otherwise the table should be printed without rules DHUN-}- -wdth2 :: Bool -> Map Int Double -> Bool -> String-wdth2 ls m b- | m /= Map.empty =- tableSpecifier b- (map- ((* (1.0 - (scalefactor (fromIntegral n)))) .- double2Float . (/ (linew2 ls)))- (Map.elems mm))- where n = (maximum (Map.keys m))- mm = wdth ls n m-wdth2 _ _ _ = []- -{-DHUN| takes the list of maximum column widths created by previous runs of the latex compiler with only one columns included per run as map from Int to Double. Take the total number of columns of the table as Int. The table is understood to be printed in landscape mode if the boolean parameter is true. It returns a map from int to double representing the width of columns of the table to be used in the latex documents. So it takes raw widths. Which are just the width of the column if the width of the paper was infinite and return the width that fit on the finite width of the real paper DHUN-}- -wdth :: Bool -> Int -> Map Int Double -> Map Int Double-wdth ls n mm- = case- (Control.Monad.msum- (map hlp- (zip- (iterate removehighest- (Map.mapMaybe- (\ x -> Just $ x / (1.0 - (scalefactor (fromIntegral n))))- mm))- [0 .. (length (Map.keys mm))])))- of- Just x -> if (sum (Map.elems x)) < (linew2 ls) then- Map.map (\ y -> y * ((linew2 ls) / (sum (Map.elems x)))) x else x- Nothing -> (myfill ((linew2 ls) / (fromIntegral n)) Map.empty)- where - hlp :: (Map Int Double, Int) -> Maybe (Map Int Double)- hlp (m, i)- | i /= n =- let s = ((sum (Map.elems m)) :: Double) in- if- ((linew2 ls) / (fromIntegral n)) * (fromIntegral i) +- (sum (Map.elems m))- < (linew2 ls)- then- Just (myfill (((linew2 ls) - s) / ((fromIntegral i) :: Double)) m)- else Nothing- hlp _ = Just (myfill ((linew2 ls) / (fromIntegral n)) Map.empty)- - myfill :: Double -> Map Int Double -> Map Int Double- myfill x m = Map.union m (Map.fromList (zip [1 .. n] (repeat x)))- -{-DHUN| In landscape mode everything has to be multiplied by a factor of two. If the boolean parameter is true it is understood that the table should be printed in landscape mode. This function return the width of the line in latex using the units of latex DHUN-}- -linew2 :: Bool -> Double-linew2 ls = if ls then linew * 1.414 else linew- -{-DHUN| The width of the line in A4 paper with DIV margin factor of 13 in latex own units DHUN-}- -linew :: Double-linew = 455.45742- -{-DHUN| convert a table form the parse tree to latex. The [Anything Char] parameter it the contend of the table represented as a parse tree. The String parameter contains the HTML attributes of the table element, or in wiki notation the HTML parameters of the line beginning with {| . This is evaluated in order to find out whether rules should be printed in the table. The return type is Renderer String. Which means that it returns a string but also take a state as additional monadic input parameter and returns a possible changed version of it as additional return parameter monadically DHUN-}- -tableToLaTeX :: [Anything Char] -> String -> Renderer String-tableToLaTeX l1 s- = do st <- get- let modst = st{getF = (getF st) * (tableScale (numberOfColumns l))}- ((_, oldstate), _)- = runState ((runStateT (tableContentToLaTeX2 reformed)) tblstate)- modst- ((t1, _), newstate)- = runState- ((runStateT (tableContentToLaTeX2 reformed))- tblstate{inputLastRowOfHeader =- if outputTableHasHeaderRows oldstate then- outputLastRowOfHeader oldstate else -2})- modst{tablist =- (maketablist reformed tblstate (numberOfColumns l) modst) :- (tablist st)}- reformed = ((reformatTableCaption (numberOfColumns l) l st))- l = stripempty l1 st- spec- = case Map.lookup tbno (tabmap st) of- Nothing -> (if (tableSpecifier sep widths) == "" then- "p{\\linewidth}" else tableSpecifier sep widths)- Just t -> wdth2 lsc t sep- sep = seperatingLinesRequested s- hline = horizontalLine sep- widths- = case Map.lookup tbno (tabmap st) of- Nothing -> columnWidths l- Just t -> wdth3 lsc t- env = tableEnvironment (getF st)- scriptsize = isInfixOf2 "latexfontsize=\"scriptsize\"" s- sb = if scriptsize then "{\\scriptsize{}" else ""- se = if scriptsize then "}" else ""- lsc = (env == "longtable") && ((numberOfColumns l) > 5)- lsb = if lsc then "\\begin{landscape}\n" else ""- lse = if lsc then "\n\\end{landscape}" else ""- tbno = (length (tablist st)) + 1- tblstate- = TableState{seperatingLinesRequestedForTable = sep,- lastCellWasNotFirstCellOfRow = False,- lastCellWasMultiColumn = False, columnsWidthList = widths,- currentColumn = 1, multiRowMap = Map.empty,- lastCellWasMultiRow = False,- numberOfColumnsInTable = (numberOfColumns l), isFirstRow = True,- lastCellWasHeaderCell = False, currentRowIsHeaderRow = False,- stillInTableHeader = True, rowCounter = 0,- outputLastRowOfHeader = 0, inputLastRowOfHeader = 0,- lastRowHadEmptyMultiRowMap = True,- outputTableHasHeaderRows = False, activeColumn = Nothing}- put $ newstate{getF = getF st}- r <- return $- lsb ++- sb ++- (if (env /= "tabular") then "\n" else "") ++- "\\begin{" ++- env ++- "}{" ++- spec ++- "}" ++- hline ++- " \n" ++- t1 ++- (rowDelimiter sep) ++ " \n\\end{" ++ env ++ "}\n" ++ se ++ lse- return r- -{-DHUN| Converts an image from the parse tree to latex. The actual images is only referenced in the wiki source, as well as the parse tree, as well as the latex source. It takes a parse tree representation of the image as only input parameter. The return type is Renderer String. Which means that it returns a string but also take a state as additional monadic input parameter and returns a possible changed version of it as additional return parameter monadically DHUN-}- -wikiImageToLaTeX :: [Anything Char] -> Renderer String-wikiImageToLaTeX l- = do st <- get- mystr <- return $- (if not (micro st) then- "\n" ++- (if ((getInTab st) == 0) then "\n" else "") ++- "\\begin{minipage}{" ++- (if (msb st) then "1.0" else (mysize st)) ++- (if (msb st) then "\\linewidth" else "\\textwidth") ++ "}\n"- else (if ((getInTab st) == 0) then "\n" else ""))- ++- (if (not (micro st)) then "\\begin{center}\n" else "") ++- "\\includegraphics[width=" ++- (if (not (micro st)) then "1.0" else (mysize st)) ++- (if (msb st) then "\\linewidth" else "\\textwidth") ++- ",height=6.5in,keepaspectratio]{../images/" ++- (n st) ++- "." ++- ext ++- "}\n" ++- (if (not (micro st)) then "\\end{center}\n" else "") ++- (if (not (tb st)) && (not (micro st)) then "\\raggedright{}"- else "")- ++- (if not (micro st) then- (if (s st) == "" then- "\\myfigurewithoutcaption{" ++ (n st) ++ "}" else- "\\myfigurewithcaption{" ++- (n st) ++ "}{" ++ (s st) ++ "}")- else "")- ++- (if not (micro st) then "\n\\end{minipage}" else "") ++- (addit st) ++- (if not (micro st) then- (if ((getInTab st) == 0) then "\n" else "") ++- "\n"- else " ")- put- st{getImages = (getImages st) ++ [shallowFlatten l],- getJ = ((getJ st) + 1)}- return mystr- where ext- = normalizeExtension- (map toLower- (fileNameToExtension (headSplitEq '|' (shallowFlatten l))))- s st- = if (trim (s1 st)) `elem` ["verweis=", "alt=", "link="] then ""- else (s1 st)- s2 st- = case Map.lookup "alt" (snd (prepateTemplate l "x")) of- Just xx -> wikiLinkCaption xx st- Nothing -> wikiLinkCaption l st- s1 st- = if '|' `elem` (shallowFlatten l) then (s2 st) else- (treeToLaTeX [] st{getJ = ((getJ st) + 1)})- mysize st = printf "%0.5f" (mysizefloat2 st)- mysizefloat st = (min (getF st) (imageSize l))- mysizefloat2 st = if (msb st) then 1.0 else (mysizefloat st)- msb st = (mysizefloat st) == (getF st)- micro st = ((mysizefloat st) < 0.17) || ((getInTab st) > 1)- n st = show (getJ st)- tb st = ((getInTab st) > 0)- addit st- = if (getInTab st) > 0 then "" else- (if not (micro st) then "\\vspace{0.75cm}" else "")- -{-DHUN| Returns the caption of a wikilink. Takes a parse tree representation of the wikilink and the current state of the renderer. Return the caption in LaTeX representation as string. A Wikilink is represented as [[FooBar]] in Wiki notation. DHUN-}- -wikiLinkCaption :: [Anything Char] -> MyState -> String-wikiLinkCaption l st = if isCaption x then rebuild x else ""- where x = (treeToLaTeX (last (splitOn [C '|'] l)) st)- rebuild (':' : xs) = xs- rebuild b = b- -{-DHUN| Returns the LaTeX representation of a wikilink. Takes a parse tree representation of the wikilink and the current state of the render. A Wikilink is represented as [[FooBar]] in Wiki notation. DHUN-}- -wikiLinkToLaTeX :: [Anything Char] -> MyState -> String-wikiLinkToLaTeX l st- = case- Map.lookup (map toUpper (finalloc st))- (Map.mapKeys (map toUpper) (urls st))- of- Just yy -> "\\my" ++- addit ++ "lref{" ++ yy ++ "}{" ++ (wikiLinkCaption l st) ++ "}"- Nothing -> case- do hh <- maybeHead . (splitOn "#") . (map toUpper) $ (finalloc st)- Map.lookup (Just hh)- (Map.mapKeys (maybeHead . (splitOn "#") . (map toUpper)) (urls st))- of- Just yy -> "\\my" ++- addit ++ "lref{" ++ yy ++ "}{" ++ (wikiLinkCaption l st) ++ "}"- Nothing -> "\\my" ++- addit ++- "href{" ++- (wikiLinkLocationesc l st) ++- "}{" ++ (killnl (wikiLinkCaption l st)) ++ "}"- where zzz sssst- = case localWikiLinkLocation (loc) of- ('#' : xs) -> (currentUrl sssst) ++ ('#' : xs)- xs -> xs- finalloc3 sts = replace2 (trim (zzz sts)) " " "_"- finalloc ssst- = case reverse (finalloc3 ssst) of- ('/' : xs) -> reverse xs- _ -> finalloc3 ssst- restpath- = intercalate "/"- (reverse (drop len (reverse (splitOn "/" (currentUrl st)))))- loc = if len > 0 then restpath ++ "/" ++ rest else rest- (len, rest) = doit2 0 (shallowFlatten l)- doit2 n ('.' : ('.' : ('/' : xs))) = doit2 (n + 1) xs- doit2 n xs = (n, xs)- addit- = if getInFootnote st then "fn" else- if ((getInTab st) > 1) then "tab" else ""- killnl ('\n' : ('\n' : xs)) = killnl ('\n' : xs)- killnl (x : xs) = x : (killnl xs)- killnl [] = []- -{-DHUN| If repeated newlines appear in a string directly after each other. Each series of newlines is reduced to exactly one newline DHUN-}- -killnl2 :: String -> String-killnl2 ('\n' : ('\n' : xs)) = killnl2 ('\n' : xs)-killnl2 ('\n' : xs)- = if (trim pre) == "" then killnl2 post else pre ++ (killnl2 post)- where pre = (takeWhile (/= '\n') xs)- post = (dropWhile (/= '\n') xs)-killnl2 (x : xs) = x : (killnl2 xs)-killnl2 [] = []- -{-DHUN| returns the caption of a link. A link is represented as [foobar.com mycaption] in wiki notation. It takes the parse tree representation of the link as first input parameter. The second input parameter is the current state of the renderer. The third parameter is the Uri scheme as string (See 'URI scheme' in the English wikipeda) usually this is 'http'. It returns the latex representation of the caption of the link as string DHUN-}- -linkCaption ::- [Anything Char] -> MyState -> String -> Bool -> String-linkCaption l st s b- = case spl of- (_ : (gg : gs)) -> (treeToLaTeX- (concat (map (\ x -> (C ' ') : x) (gg : gs)))- st)- _ -> if b then "" else s ++ (escapelink (linkLocation l))- where spl = splitOn [C ' '] l- -{-DHUN| returns the latex representation of a link. A link is represented as [foobar.com mycaption] in wiki notation. It takes the parse tree representation of the link as first input parameter. The second input parameter is the current state of the renderer. The third parameter is the Uri scheme as string (See 'URI scheme' in the English wikipeda) usually this is 'http'. It returns the latex representation of the link as string DHUN-}- -linkToLaTeX :: [Anything Char] -> MyState -> String -> String-linkToLaTeX l st s- = if- (b && cap == "") || (cap == (s ++ (escapelink (linkLocation l))))- then "\\myplainurl{" ++ s ++ (escapelink (linkLocation l)) ++ "}"- else- "\\my" ++- addit ++- "href{" ++ s ++ (escapelink (linkLocation l)) ++ "}{" ++ cap ++ "}"- where addit = if b then "fn" else ""- b = getInFootnote st- cap = (linkCaption l st s b)- -{-DHUN| takes a list and splits it into sublist of equal length, allowing a possible smaller length for the last list in case the devision does not create an integer result. DHUN-}- -splitToTuples :: [a] -> [[a]]-splitToTuples x- = map (take galleryNumberOfColumns) .- takeWhile (not . null) . iterate (drop galleryNumberOfColumns)- $ x- -{-DHUN| the number of column to be used in latex documents for mediawikis gallery (image gallery) (gallery tags) DHUN-}- -galleryNumberOfColumns :: Int-galleryNumberOfColumns = 1- -{-DHUN| the width of a column for the table of the latex version of mediawikis gallery (image gallery, gallery tags) DHUN-}- -galleryTableScale :: Float-galleryTableScale- = (1.0 / (fromIntegral galleryNumberOfColumns)) - (scalefactor 1.0)- -{-DHUN| the latex string for a single column in table header in the latex version of mediawikis gallery (image gallery, gallery tag) DHUN-}- -galleryTableSpecifier :: String-galleryTableSpecifier- = concat $- replicate galleryNumberOfColumns- ">{\\RaggedRight}p{0.5\\linewidth}"- -{-DHUN| converts the inner parts gallery (image gallery, gallery tag) from parse tree notation to latex, does not write the latex table header and footer. This is only a helper function. Always use galleryToLatex if you want to convert a gallery to latex DHUN-}- -galleryContentToLatex :: [[Anything Char]] -> Renderer String-galleryContentToLatex (x : xs)- = do s <- galleryRowToLaTex x- ss <- galleryContentToLatex xs- return $ s ++ "\\\\ \n" ++ ss-galleryContentToLatex [] = return []- -{-DHUN| converts a part of a gallery (image gallery, gallery tag) from parse tree to latex. A part are as many elements as fit into a single row in the resulting latex table DHUN-}- -galleryRowToLaTex :: [Anything Char] -> Renderer String-galleryRowToLaTex [] = return []-galleryRowToLaTex (x : []) = treeToLaTeX2 [x]-galleryRowToLaTex (x : xs)- = do s <- treeToLaTeX2 [x]- g <- galleryRowToLaTex xs- return $ s ++ "&" ++ g- -{-DHUN| Converts are gallery (image gallery, gallery tag) from parse tree to latex. Also writes table header and footer. This is the function you should use for converting galleries to latex DHUN-}- -galleryToLatex :: [Anything Char] -> Renderer String-galleryToLatex x- = do st <- get- put st{getF = (getF st) * galleryTableScale}- s <- (galleryContentToLatex- [z | z <- splitToTuples [y | y <- x, isWikiLink y],- trim (treeToLaTeX z st) /= ""])- st2 <- get- put st2{getF = (getF st)}- return- ("\\begin{longtable}{" ++- galleryTableSpecifier ++ "} \n" ++ s ++ "\\end{longtable}")- -{-DHUN| A function to drop all unnecessary elements of an HTML image map, so that it can be converted to latex by calling treeToLaTeX2 DHUN-}- -imageMapClean :: [Anything Char] -> [Anything Char]-imageMapClean ((Environment Wikilink s l) : xs)- = (Environment Wikilink s l) : imageMapClean xs-imageMapClean (_ : xs) = imageMapClean xs-imageMapClean [] = []- -{-DHUN| Takes the parse tree representation of an image, and returns the its size in unit of the width of a line in latex. Images 400px or wider in wiki notation are understood to use the full width of the line. Smaller one are considered fractionally. That means 100px means 0.25 the width of the line and 200px means 0.5 width of the line DHUN-}- -imageSize :: [Anything Char] -> Float-imageSize l = if [] == x then 1.0 else (minimum x)- where x = map readImageSize (imageSizeStrings (shallowFlatten l))- -{-DHUN| takes a candidate string for the width of an image in the wikis px notation. Returns 1.0 if the candidate could not be parsed, returns the width of the image in units of the width of a line in latex otherwise. Images 400px or wider in wiki notation are understood to use the full width of the line. Smaller one are considered fractionally. That means 100px means 0.25 the width of the line and 200px means 0.5 width of the line DHUN-}- -readImageSize :: String -> Float-readImageSize y- = case (reads x) of- [] -> 1.0- (h : _) -> fst h / 400.0- where x = removex y- removex ('x' : zs) = zs- removex z = z- -{-DHUN| takes a flattend version of a parse tree represendtation of an image and retruns a list of substrings which are candidates for representing the width of the image in the wikis px notation DHUN-}- -imageSizeStrings :: String -> [String]-imageSizeStrings s- = [take (length (x) - 2) (x) |- x <- ((splitOn ['|'] s) :: [String]), isSuffixOf "px" x]- -{-DHUN| converts a mathematical fomula from the wiki to latex notation DHUN-}- -mathToLatex :: [Anything Char] -> String-mathToLatex l- = if isInfixOf2 "\\begin{alignat}" (shallowFlatten l) then- mathTransform l else "{$" ++ (mathTransform l) ++ "$}"- -{-DHUN| a predicate that returns true if and only if the input is a parse tree that contains only spaces but no other structures DHUN-}- -onlySpaces :: [Anything Char] -> Bool-onlySpaces ((C ' ') : xs) = onlySpaces xs-onlySpaces [] = True-onlySpaces _ = False- -{-DHUN| in the wiki notation pipe (|)inside temples are escaped as {!} and double pipes as {!!}}. this function undoes this escaping in a parse tree DHUN-}- -prepateParameter :: [Anything Char] -> [Anything Char]-prepateParameter ((Environment Template _ [C '!']) : xs)- = (C '|') : prepateParameter xs-prepateParameter ((Environment Template _ [C '!', C '!']) : xs)- = (C '|') : (C '|') : prepateParameter xs-prepateParameter (x : xs) = x : prepateParameter xs-prepateParameter [] = []- -{-DHUN| this function prepares a template as parse by the parser in the parse tree notation into a other notation that can be further processes by the latex renderer and the function templateToLatex in particular. The first input parameter is the parse tree notation of the template. The second is the name of the template as string. It returns a tuple, the first element of this tuple is the name of the template (stripped of heading an tailing white space) and the second element of the tuple is a map from strings to parse trees. The strings are the names of the parameters of the template. These might be just numbers represented as string but also any other strings DHUN-}- -prepateTemplate ::- [Anything Char] -> String -> (String, Map String [Anything Char])-prepateTemplate ll x = (trim x, enum ll 1 (Map.fromList []))- where - enum ::- [Anything Char] ->- Integer -> Map String [Anything Char] -> Map String [Anything Char]- enum ((Environment TemplateInside (Str "") l) : zs) i d- = enum zs (i + 1) (Map.insert (show i) (prepateParameter l) d)- enum ((Environment TemplateInside (Str z) l) : zs) i d- = enum zs i (Map.insert (trim z) (prepateParameter l) d)- enum [] _ d = d- enum (_ : zs) i d = enum zs i d- -{-DHUN| converts a template from the wiki to latex. The first parameter is the parse tree representation of the template as generated by the parse the second is the name of the template. It returns a Renderer String. That is it returns the latex representation of the template, but also takes a state as an additional monadic input parameter and returns a possible changed version of it as additional return parameter monadically DHUN-}- -templateToLatex :: [Anything Char] -> String -> Renderer String-templateToLatex l s- = state $- \ st ->- case l of- ((C 'w') : ((C '|') : xs)) -> (wikiLinkToLaTeX- ((C 'w') : (C ':') : xs)- st,- st)- ((C 'W') : ((C '|') : xs)) -> (wikiLinkToLaTeX- ((C 'w') : (C ':') : xs)- st,- st)- ((C 'B') : ((C '|') : xs)) -> (wikiLinkToLaTeX xs st, st)- _ -> swap $ templateProcessor st (prepateTemplate l s)- -{-DHUN| function to converts wikipedias citearticle template to latex DHUN-}- -citearticle :: Map String [Anything Char] -> Renderer String-citearticle ll- = state $- \ st ->- ((treeToLaTeX (Map.findWithDefault [] "author" ll) st) ++- (treeToLaTeX (Map.findWithDefault [] "first" ll) st) ++- (if Map.member "first" ll then " " else "") ++- (treeToLaTeX (Map.findWithDefault [] "last" ll) st) ++- ". " ++- (treeToLaTeX (Map.findWithDefault [] "title" ll) st) ++- (if Map.member "url" ll then- "\\my" ++- (if getInFootnote st then "fn" else "") ++- "href{" ++- (treeToLaTeX (deepFlatten (Map.findWithDefault [] "url" ll)) st) ++- "}{" ++ (treeToLaTeX (Map.findWithDefault [] "title" ll) st) ++ "}"- else (treeToLaTeX (Map.findWithDefault [] "title" ll) st))- ++- ". " ++- "\\textit{{}" ++- (treeToLaTeX (Map.findWithDefault [] "journal" ll) st) ++- "}, " ++- (if Map.member "volume" ll then- "{{\\bfseries " ++- (treeToLaTeX (Map.findWithDefault [] "volume" ll) st) ++ "}}"- else "")- ++- (if Map.member "publisher" ll then- "(" ++- (treeToLaTeX (Map.findWithDefault [] "publisher" ll) st) ++- ")"- else "")- ++- (if Map.member "number" ll then- "(" ++- (treeToLaTeX (Map.findWithDefault [] "number" ll) st) ++ ")"- else "")- ++- (if Map.member "pages" ll then- ":" ++ (treeToLaTeX (Map.findWithDefault [] "pages" ll) st)- else "")- ++- (if Map.member "month" ll then- (treeToLaTeX (Map.findWithDefault [] "month" ll) st) else- "")- ++- (treeToLaTeX (Map.findWithDefault [] "year" ll) st) ++- "\n",- st)- -{-DHUN| removes source structures from a parse tree, keeping the source inside the source structure in the parse tree, so flattens out the source structure. You need this if some parse tree contains source code but you don't know whether or not it is inside a source tag DHUN-}- -flattensource :: [Anything Char] -> [Anything Char]-flattensource ((Environment Source (TagAttr _ _) l) : xs)- = l ++ (flattensource xs)-flattensource (x : xs) = x : (flattensource xs)-flattensource [] = []- -{-DHUN| prepare code for printing in latex. takes the current state of the renderer as first parameter. takes the map version of the template containing the code as second parameter. returns the latex representation as string DHUN-}- -trilex :: MyState -> Map String [Anything Char] -> String-trilex st ll = trilexgen st ll "code"- -{-DHUN| prepare code for printing in latex. Takes the map version of the template containing the code as first parameter. returns the latex representation as string. It returns a Render String so that it can access the current state of the renderer as additional monadic input parameter DHUN-}- -trilex2 :: Map String [Anything Char] -> Renderer String-trilex2 ll- = do st <- get- return $ trilexgen st ll "code"- -{-DHUN| prepare code for printing in latex. takes the current state of the renderer as first parameter. takes the map version of the template containing the code as second parameter. takes the name of the parameter containing the actual source in the map as third parameter. returns the latex representation as string DHUN-}- -trilexgen ::- MyState -> Map String [Anything Char] -> String -> String-trilexgen st ll code- = if Map.member code ll then- (treeToLaTeX- (breakLines3 73- (killnewline (flattensource (Map.findWithDefault [] code ll))))- st)- else ""- where - killnewline :: [Anything Char] -> [Anything Char]- killnewline ((C '\n') : xs) = killnewline xs- killnewline x = x- -{-DHUN| analyzes a color in HTML notation. It returns a triple. The first element is a boolean. If it is true the color has got rgb hex notation and the third parameter contains the rgb latex notation. If it is false, the color is not rgb and hopefully a HTML color name, which is returned a second element of the tuple DHUN-}- -colinfo :: String -> (Bool, String, String)-colinfo colcode- = case col of- Just colo -> (True, map toLower colname, colo)- Nothing -> (False, map toLower colname,- case colnamehelper of- Just x -> x- Nothing -> colcode)- where col = (makecol colnamehelper)- colnamehelper- = case colcode of- (_ : (_ : gs)) -> Just gs- _ -> Nothing- colname- = case- do n <- colnamehelper- guard $ mypred n- return ("rgb" ++ n)- of- Just x -> x- Nothing -> colcode- - ss :: String -> [Integer]- ss (a : (b : xs)) = (maybeToList . unhex $ [a, b]) ++ (ss xs)- ss _ = []- - ss3 :: String -> [Integer]- ss3 (a : xs) = (maybeToList . unhex $ [a, a]) ++ (ss3 xs)- ss3 _ = []- - ss2 :: [Integer] -> [Float]- ss2 (x : xs) = ((fromInteger x) / 255.0) : ss2 xs- ss2 [] = []- ss4 x = if (((length . ss) x) == 3) then ss x else ss3 x- - prettyp2 :: [String] -> String- prettyp2 (x : []) = x- prettyp2 (x : xs) = x ++ "," ++ (prettyp2 xs)- prettyp2 [] = []- - prettyp :: [String] -> String- prettyp x = "{" ++ (prettyp2 x) ++ "}"- - makecol :: Maybe String -> Maybe String- makecol x- = do xx <- x- guard $ mypred xx- return $- prettyp ((map (printf "%0.5f") ((ss2 . ss4) xx)) :: [String])- mypred x = (((length . ss) x) == 3) || (((length . ss3) x) == 3)- -{-DHUN| and adapter to convert between the monadic and non monadic version of render. A function returning renderer string means that it returns a string but takes a state as additional monadic input parameter and returns the a possibly modified version of it as an additional monadic output parameter. This function takes a monadic return value. That is renderer String and returns its non monadic version. DHUN-}- -tempProcAdapter ::- Renderer String -> (MyState -> (MyState, String))-tempProcAdapter = (swap .) . runState- -{-DHUN| function for key strokes templates in the blender wikibook DHUN-}- -key :: [Char] -> [Char]-key "AKEY" = "A"-key "BKEY" = "B"-key "CKEY" = "C"-key "DKEY" = "D"-key "EKEY" = "E"-key "FKEY" = "F"-key "GKEY" = "G"-key "HKEY" = "H"-key "IKEY" = "I"-key "JKEY" = "J"-key "KKEY" = "K"-key "LKEY" = "L"-key "MKEY" = "M"-key "NKEY" = "N"-key "OKEY" = "O"-key "PKEY" = "P"-key "QKEY" = "Q"-key "RKEY" = "R"-key "SKEY" = "S"-key "TKEY" = "T"-key "UKEY" = "U"-key "VKEY" = "V"-key "WKEY" = "W"-key "XKEY" = "X"-key "YKEY" = "Y"-key "ZKEY" = "Z"-key "-KEY" = "-{}"-key "SEMICOLON" = ";"-key "NUM-" = "NUM-{}"-key x = x- -{-DHUN| converts a template to latex. Takes the current state of the render as first input parameter. The second input parameter is a tuple. Its first element is the name of the template as string. Its second element is a map, mapping the names of the parameters of the template to their parse tree representations, it returns a tuple. The First element is the possible change state of the renderer the second one is the latex representation of the template DHUN-}- -templateProcessor ::- MyState ->- (String, Map String [Anything Char]) -> (MyState, String)-templateProcessor st ("main", ll)- = (st,- "Main Page: " ++- (wikiLinkToLaTeX (Map.findWithDefault [] "1" ll) st))-templateProcessor st ("!", _) = (st, "|")-templateProcessor st ("!!", _) = (st, "||")-templateProcessor st- ("Mathe f\252r Nicht-Freaks: Vorlage:Frage", ll) = (st2, r)- where j1 x = (Map.findWithDefault [] x ll)- (r, st2)- = runState- (do a <- treeToLaTeX2 (j1 "typ")- b <- treeToLaTeX2 (j1 "frage")- c <- treeToLaTeX2 (j1 "antwort")- return $- if Map.member "typ" ll then- "\\NFFrage{" ++ a ++ "}{" ++ b ++ "}{" ++ c ++ "}" else- "\\NFFrageB{" ++ b ++ "}{" ++ c ++ "}")- st-templateProcessor st ("Aufgabensammlung: Vorlage:Frage", ll)- = (st2, r)- where j1 x = (Map.findWithDefault [] x ll)- (r, st2)- = runState- (do a <- treeToLaTeX2 (j1 "typ")- b <- treeToLaTeX2 (j1 "frage")- c <- treeToLaTeX2 (j1 "antwort")- return $- if Map.member "typ" ll then- "\\NFFrage{" ++ a ++ "}{" ++ b ++ "}{" ++ c ++ "}" else- "\\NFFrageB{" ++ b ++ "}{" ++ c ++ "}")- st-templateProcessor st- ("Mathe f\252r Nicht-Freaks: Vorlage:Mind Map", ll)- = (st2,- "\\section*{Mind Map}\\begin{landscape}" ++- r ++ "\\end{landscape}")- where (r, st2)- = runState- (wikiImageToLaTeX- ((C 'F') :- (C 'i') :- (C 'l') : (C 'e') : (C ':') : (Map.findWithDefault [] "1" ll)))- st-templateProcessor st- ("C++-Programmierung/ Vorlage:Buchinterner Link", ll)- = (st,- wikiLinkToLaTeX- (if- ("" /=- (if length (splitOn "/" (currentUrl st)) > 2 then- (id ((splitOn "/" (currentUrl st)) !! 2)) else []))- then- if Map.member "\220berschrift" ll then- (map (C) "C++-Programmierung/ ") ++- (Map.findWithDefault [] "Abschnitt" ll) ++- [C '/', C ' '] ++- (Map.findWithDefault [] "Kapitel" ll) ++- [C '#'] ++- (Map.findWithDefault [] "\220berschrift" ll) ++- (if Map.member "Kapitelzusatz" ll then- ((C) '_') : (Map.findWithDefault [] "Kapitelzusatz" ll) else [])- else- (if Map.member "Kapitel" ll then- (map (C) "C++-Programmierung/ ") ++- (Map.findWithDefault [] "Abschnitt" ll) ++- [C '/', C ' '] ++ (Map.findWithDefault [] "Kapitel" ll)- else- (map (C) "C++-Programmierung/ Inhaltsverzeichnis#Anker:") ++- (Map.findWithDefault [] "Abschnitt" ll))- ++- [C '|'] ++- (Map.findWithDefault- (Map.findWithDefault- (Map.findWithDefault (Map.findWithDefault [] "Abschnitt" ll)- "Kapitel"- ll)- "\220berschrift"- ll)- "Text"- ll)- else- if Map.member "\220berschrift" ll then- (map (C) "C++-Programmierung/ ") ++- (Map.findWithDefault [] "Abschnitt" ll) ++- [C '#'] ++- (Map.findWithDefault [] "\220berschrift" ll) ++- (if Map.member "Abschnittszusatz" ll then- ((C) '_') : (Map.findWithDefault [] "Abschnittszusatz" ll) else [])- else- (if Map.member "Kapitel" ll then- (map (C) "C++-Programmierung/ ") ++- (Map.findWithDefault [] "Abschnitt" ll) ++- [C '#'] ++ (Map.findWithDefault [] "Kapitel" ll)- else- (map (C) "C++-Programmierung/ ") ++- (Map.findWithDefault [] "Abschnitt" ll))- ++- [C '|'] ++- (Map.findWithDefault- (Map.findWithDefault- (Map.findWithDefault (Map.findWithDefault [] "Abschnitt" ll)- "Kapitel"- ll)- "\220berschrift"- ll)- "Text"- ll))- st)-templateProcessor st ("B3D:N2P/Do", ll)- = (st,- intercalate "+"- (filter (/= "\\keystroke{}")- (map- (\ x ->- "\\keystroke{" ++- (key . (map toUpper))- (treeToLaTeX (Map.findWithDefault [] (show x) ll) st)- ++ "}")- ([1, 2, 3, 4] :: [Integer]))))-templateProcessor st ("HaskellGHCiExample", ll)- = (st,- ("\\LaTeXDoubleBoxTemplate{Example:}{" ++- (treeToLaTeX (Map.findWithDefault [] "1" ll) st) ++- "\\newline " ++ trilexgen st ll "2" ++ "}\n"))-templateProcessor st ("Latex Index", ll)- = (st,- ("\\index{" ++ (concatMap go- (deepFlatten (Map.findWithDefault [] "1" ll))) ++"}"))- where - go (C x) = [x]- go _ = []-templateProcessor st ("HaskellExample", ll)- = (st,- ("\\LaTeXDoubleBoxTemplate{Example:}{" ++- (treeToLaTeX (Map.findWithDefault [] "1" ll) st) ++- (treeToLaTeX (Map.findWithDefault [] "2" ll) st) ++ "}\n"))-templateProcessor st ("Ada/95/RM", ll)- = (st,- (linkToLaTeX- ((map C- "http://www.adaic.org/resources/add_content/standards/95lrm/ARM_HTML/RM-")- ++- one ++- (if has then [C '-'] else []) ++- two ++- (map C ".html") ++- [C ' '] ++- (if has then one ++ [C '.'] ++ two else- (map C "Annex ") ++ one ++ [C ':'])- ++ [C ' '] ++ (Map.findWithDefault [] "title" ll))- st- ""))- where one = (Map.findWithDefault [] "1" ll)- two = (Map.findWithDefault [] "2" ll)- has = Map.member "2" ll-templateProcessor st ("Ada/2005/RM", ll)- = (st,- (linkToLaTeX- ((map C- "http://www.adaic.org/resources/add_content/standards/05rm/html/RM-2-")- ++- one ++- (if has then [C '-'] else []) ++- two ++- (map C ".html") ++- [C ' '] ++- (if has then one ++ [C '.'] ++ two else- (map C "Annex ") ++ one ++ [C ':'])- ++ [C ' '] ++ (Map.findWithDefault [] "title" ll))- st- ""))- where one = (Map.findWithDefault [] "1" ll)- two = (Map.findWithDefault [] "2" ll)- has = Map.member "2" ll-templateProcessor st ("Ada/2012/RM", ll)- = (st,- (linkToLaTeX- ((map C "http://www.ada-auth.org/standards/12rm/html/RM-") ++- one ++- (if has then [C '-'] else []) ++- two ++- (map C ".html") ++- [C ' '] ++- (if has then one ++ [C '.'] ++ two else- (map C "Annex ") ++ one ++ [C ':'])- ++ [C ' '] ++ (Map.findWithDefault [] "title" ll))- st- ""))- where one = (Map.findWithDefault [] "1" ll)- two = (Map.findWithDefault [] "2" ll)- has = Map.member "2" ll-templateProcessor st ("Fortran:Vorlage: Pre1", ll)- = (st,- "{\\ttfamily {\\scriptsize " ++- "\\newline{}" ++- s1 ++- "\\newline{}" ++- s2 ++- "\\newline{}" ++- (treeToLaTeX (Map.findWithDefault [] "1" ll) st) ++- "\\newline{}" ++- s2 ++ "\\newline{}" ++ s1 ++ "\\newline{}" ++ "}}\n")- where s1- = "0${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}.${\\ttfamily }${}|${\\ttfamily }${}${\\ttfamily }${}1${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}.${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}2${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}.${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}3${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}.${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}4${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}.${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}5${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}.${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}6${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}.${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}7${\\ttfamily }${}|${\\ttfamily }${}${\\ttfamily }${}.${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}8"- s2- = "12345678901234567890123456789012345678901234567890123456789012345678901234567890"-templateProcessor st ("Fortran:Vorlage: Pre2", ll)- = (st,- "{\\bfseries Fortran 90/95-Code (free source form) }\\newline" ++- "{\\ttfamily {\\scriptsize " ++- (treeToLaTeX (Map.findWithDefault [] "1" ll) st) ++ "}}\n")-templateProcessor st ("Fortran:Vorlage: Pre3", ll)- = (st,- "{\\bfseries Programmcode} \\newline" ++- "{\\ttfamily {\\scriptsize " ++- (treeToLaTeX (Map.findWithDefault [] "1" ll) st) ++ "}}\n")-templateProcessor st ("Fortran:Vorlage: Pre4", ll)- = (st,- "{\\bfseries Fortran 2003-Code} \\newline" ++- "{\\ttfamily {\\scriptsize " ++- (treeToLaTeX (Map.findWithDefault [] "1" ll) st) ++ "}}\n")-templateProcessor st ("Fortran:Vorlage: Intrinsic", ll)- = (st,- "\\newline{}\n" ++- (treeToLaTeX (Map.findWithDefault [] "1" ll) st) ++- " = {\\bfseries " ++- (treeToLaTeX (Map.findWithDefault [] "2" ll) st) ++- "} ( " ++- (treeToLaTeX (Map.findWithDefault [] "3" ll) st) ++- " )\\newline{}\n")-templateProcessor st ("Fortran:Vorlage: IntrinsicS", ll)- = (st,- "\\newline{}\n {\\bfseries " ++- (treeToLaTeX (Map.findWithDefault [] "1" ll) st) ++- "} ( " ++- (treeToLaTeX (Map.findWithDefault [] "2" ll) st) ++- " )\\newline{}\n")-templateProcessor st ("Fortran:Vorlage: Isocbinding", ll)- = (st,- "Beispiel funktioniert mit Compiler\n" ++- "\\begin{myitemize}\n" ++- "\\item g95 (0.91!) May 10 2007: " ++- (treeToLaTeX (Map.findWithDefault [] "1" ll) st) ++- "\n" ++- "\\item gfortran 4.3.0 20070723 (experimental): " ++- (treeToLaTeX (Map.findWithDefault [] "2" ll) st) ++- "\n" ++- "\\item Intel Fortran Compiler 10.0: " ++- (treeToLaTeX (Map.findWithDefault [] "3" ll) st) ++- "\n" ++- "\\item Sun Studio Express - June 2007: " ++- (treeToLaTeX (Map.findWithDefault [] "4" ll) st) ++- "\n" ++- "\\end{myitemize}\n" ++- "Anmerkungen:\\newline{}\n" ++- (treeToLaTeX (Map.findWithDefault [] "5" ll) st) ++ "\n")-templateProcessor st ("C++-Programmierung/ Vorlage:Aufgabe", ll)- = (st,- ("{\\bfseries Aufgabe " ++- (treeToLaTeX (Map.findWithDefault [] "Nummer" ll) st) ++- "} \n" ++- (treeToLaTeX (Map.findWithDefault [] "Aufgabe" ll) st) ++- "\n {\\bfseries Musterl\246sung} \n" ++- (treeToLaTeX (Map.findWithDefault [] "L\246sung" ll) st) ++ " \n"))-templateProcessor st ("-", _) = (st, "\\newline{}")-templateProcessor st ("Haskell speaker 2", ll) = (st, param "1")- where param n = (treeToLaTeX (Map.findWithDefault [] n ll) st)-templateProcessor st ("Vorlage:LaTeX Mehrspaltig Anfang", ll)- = (st, "\\begin{multicols}{" ++ (param "1") ++ "}")- where param n = (treeToLaTeX (Map.findWithDefault [] n ll) st)-templateProcessor st ("Vorlage:LaTeX Mehrspaltig Ende", _)- = (st, "\\end{multicols}")-templateProcessor st ("Vorlage:Referenzbox IntraBuch", ll)- = (st,- "{\\bfseries Querverweise:} Siehe auch " ++- (treeToLaTeX (Map.findWithDefault [] "1" ll) st))-templateProcessor st ("unicode", ll)- = (st, (treeToLaTeX (Map.findWithDefault [] "1" ll) st))-templateProcessor st- ("Praktikum Anorganische Chemie/ Vorlage:Infobox Nachweisreaktion",- ll)- = (st,- "\\begin{tabular}{|p{0.3\\linewidth}|p{0.7\\linewidth}|}\\hline\n"- ++- "\\multicolumn{2}{|p{1.0\\linewidth}|}{{\\bfseries Nachweisreaktion}} \\\\ \\hline\n"- ++- "Reaktionstyp & " ++- (treeToLaTeX (Map.findWithDefault [] "Typ" ll) st) ++- " \\\\ \\hline\n" ++- "pH & " ++- (treeToLaTeX (Map.findWithDefault [] "pH" ll) st) ++- "\\\\ \\hline\n" ++- "Indikation & " ++- (treeToLaTeX (Map.findWithDefault [] "Indikation" ll) st) ++- "\\\\ \\hline \n\\end{tabular}\n")-templateProcessor st- ("Praktikum Anorganische Chemie/ Vorlage:Gift", _)- = (st, "{\\bfseries Gefahrstoffwarnung! $\\skull$ }")-templateProcessor st ("Wikibooks", ll)- = (st, wikiLinkToLaTeX ((Map.findWithDefault [] "1" ll)) st)-templateProcessor st ("See also", ll)- = (st,- "See also: " ++- (wikiLinkToLaTeX ((Map.findWithDefault [] "1" ll)) st))-templateProcessor st ("info", ll)- = (st,- "\\begin{TemplateInfo}{}{}" ++- (treeToLaTeX ((Map.findWithDefault [] "1" ll)) st) ++- "\\end{TemplateInfo}")-templateProcessor st ("Java:statement1", _)- = (st, "statement{$_{\\textrm{\\scriptsize 1}}$}")-templateProcessor st ("Java:statement2", _)- = (st, "statement{$_{\\textrm{\\scriptsize 2}}$}")-templateProcessor st ("Java:boolean-condition", _)- = (st, "boolean-condition")-templateProcessor st ("Java:ch", ll)- = (st,- "'" ++ (treeToLaTeX ((Map.findWithDefault [] "1" ll)) st) ++ "'")-templateProcessor st ("Ubung", _) = (st, "\\ubung")-templateProcessor st ("TickYes", _) = (st, "\\TickYes")-templateProcessor st ("Achtung", ll)- = (st,- "\\begin{TemplateInfo}{\\danger}{Achtung}" ++- (treeToLaTeX ((Map.findWithDefault [] "1" ll)) st) ++- "\\end{TemplateInfo}")-templateProcessor st ("Warning", ll)- = (st,- "\\begin{TemplateInfo}{\\danger}{Warning}" ++- (treeToLaTeX ((Map.findWithDefault [] "1" ll)) st) ++- "\\end{TemplateInfo}")-templateProcessor st ("warning", ll)- = (st,- "\\begin{TemplateInfo}{\\danger}{Warning}" ++- (treeToLaTeX ((Map.findWithDefault [] "1" ll)) st) ++- "\\end{TemplateInfo}")-templateProcessor st ("Notiz", ll)- = (st,- "\\begin{TemplateInfo}{}{Notiz}" ++- (treeToLaTeX ((Map.findWithDefault [] "1" ll)) st) ++- "\\end{TemplateInfo}")-templateProcessor st ("Vorlage:Zitat3", ll)- = (st,- "\\begin{longtable}{|p{\\linewidth}|}\\hline\n \\uline{" ++- (treeToLaTeX ((Map.findWithDefault [] "autor" ll)) st) ++- "}\\\\\\textit{\n" ++- (treeToLaTeX ((Map.findWithDefault [] "zitat" ll)) st) ++- "}\\scriptsize \\\\ \\RaggedLeft \\scriptsize \n" ++- (treeToLaTeX ((Map.findWithDefault [] "quelle" ll)) st) ++- "\\\\ \\hline \n\\end{longtable}\n")-templateProcessor st ("C++-Programmierung/ Vorlage:Frage", ll)- = (st,- if Map.member "Aufgabe" ll then- ("\\begin{longtable}{|p{\\linewidth}|}\\hline\n {\\bfseries Aufgabe "- ++- (treeToLaTeX (Map.findWithDefault [] "Nummer" ll) st) ++- "} \\\\ \\hline\n" ++- (treeToLaTeX (Map.findWithDefault [] "Aufgabe" ll) st) ++- "\\\\ \\hline\n {\\bfseries Musterl\246sung} \\\\ \\hline\n" ++- (treeToLaTeX (Map.findWithDefault [] "L\246sung" ll) st) ++- "\\\\ \\hline \n\\end{longtable}\n")- else- ("\\begin{longtable}{|p{\\linewidth}|}\\hline\n {\\bfseries Frage "- ++- (treeToLaTeX (Map.findWithDefault [] "Nummer" ll) st) ++- "} \\\\ \\hline\n" ++- (treeToLaTeX (Map.findWithDefault [] "Frage" ll) st) ++- "\\\\ \\hline\n {\\bfseries Antwort} \\\\ \\hline\n" ++- (treeToLaTeX (Map.findWithDefault [] "Antwort" ll) st) ++- "\\\\ \\hline \n\\end{longtable}\n"))-templateProcessor st ("merke", ll)- = (st,- "\\begin{TemplateInfo}{}{" ++- heading ++- "}" ++- (treeToLaTeX ((Map.findWithDefault [] "1" ll)) st) ++- "\\end{TemplateInfo}")- where heading- = if Map.member "info" ll then- treeToLaTeX (Map.findWithDefault [] "info" ll) st else "Hinweis"-templateProcessor st ("Merke", ll)- = (st,- "\\begin{TemplateInfo}{}{" ++- heading ++- "}" ++- (treeToLaTeX ((Map.findWithDefault [] "1" ll)) st) ++- "\\end{TemplateInfo}")- where heading- = if Map.member "info" ll then- treeToLaTeX (Map.findWithDefault [] "info" ll) st else "Hinweis"-templateProcessor st ("Zitat", ll)- = (st,- "\\begin{longtable}{|p{\\linewidth}|}\\hline\n" ++- (if Map.member "beschreibung" ll then- (treeToLaTeX ((Map.findWithDefault [] "beschreibung" ll)) st) ++- "\\\\ \\hline"- else "")- ++- " \\uline{" ++- (treeToLaTeX ((Map.findWithDefault [] "autor" ll)) st) ++- "}\\\\\\textit{\n" ++- (treeToLaTeX ((Map.findWithDefault [] "zitat" ll)) st) ++- "}\\scriptsize \\\\ \\RaggedLeft \\scriptsize \n" ++- (treeToLaTeX ((Map.findWithDefault [] "quelle" ll)) st) ++- "\\\\ \\hline \n\\end{longtable}\n")-templateProcessor st ("java web api", ll)- = (st,- "\\myhref{http://java.sun.com/javase/6/docs/api/" ++- loc ++ "}{" ++ cap ++ "}")- where - loc :: String- loc = (shallowFlatten (Map.findWithDefault [] "1" ll))- - cap :: String- cap- = "Java API: " ++ (treeToLaTeX (Map.findWithDefault [] "2" ll) st)-templateProcessor st- ("Python_unter_Linux: Vorlagen:VorlageAusgabe", ll)- = (st,- ("\n{\\bfseries Ausgabe}\\\\\n{\\ttfamily \\scriptsize \n" ++- ("user\\@localhost:\\~\\$" ++- (treeToLaTeX- (breakLines3 linewidth (Map.findWithDefault [] "1" ll))- st)- ++- "\\newline " ++- (treeToLaTeX- (id- (filter- (\ x ->- case x of- C '\n' -> False- (Environment Tag (TagAttr "br" _) _) -> True- _ -> True)- (Map.findWithDefault [] "2" ll)))- st))- ++ "}\n"))-templateProcessor st ("Python_unter_Linux: Vorlagen:VorlageQZ", ll)- = (st,- ("{\\ttfamily \\uline{" ++- (treeToLaTeX (breakLines3 100 (Map.findWithDefault [] "1" ll)) st)- ++ "}}"))-templateProcessor st- ("Python_unter_Linux: Vorlagen:VorlageQZ", ll)- = (st,- ("{\\ttfamily \\uline{" ++- (treeToLaTeX (breakLines3 100 (Map.findWithDefault [] "1" ll)) st)- ++ "}}"))-templateProcessor st ("Python unter Linux: Vorlagen:VorlageQZ", ll)- = (st,- ("{\\ttfamily \\uline{" ++- (treeToLaTeX (breakLines3 100 (Map.findWithDefault [] "1" ll)) st)- ++ "}}"))-templateProcessor st ("C++-Programmierung/ Vorlage:Syntax", ll)- = (st,- "{\\ttfamily {\\scriptsize " ++- (treeToLaTeX (breakLines3 96 (Map.findWithDefault [] "code" ll))- st)- ++ "}}\n")-templateProcessor st- ("C++-Programmierung/ Vorlage:Kapitelanhang", ll)- = (st,- ((if Map.member "Zusammenfassung" ll then- "\n {\\bfseries \\large Zusammenfassung} \n " ++- (treeToLaTeX (Map.findWithDefault [] "Zusammenfassung" ll) st)- else "")- ++- (if Map.member "Fragen" ll then- "\n {\\bfseries \\large Fragen} \n " ++- (treeToLaTeX (Map.findWithDefault [] "Fragen" ll) st)- else "")- ++- (if Map.member "Aufgaben" ll then- "\n {\\bfseries \\large Aufgaben} \n " ++- (treeToLaTeX (Map.findWithDefault [] "Aufgaben" ll) st)- else "")- ++ " \n"))-templateProcessor st ("C++-Programmierung/ Vorlage:Code", ll)- = (st,- ("{\\ttfamily {\\scriptsize" ++- ((formatLaTeXBlock defaultFormatOpts)- (highlightAs "c++"- (shallowFlatten- (map renormalize- (breakLines3 96 (Map.findWithDefault [] "code" ll))))))- ++- "}}\n" ++- (if (Map.member "output" ll) then- "{\\bfseries Ausgabe}\n{\\ttfamily {\\scriptsize" ++- (treeToLaTeX (breakLines3 96 (Map.findWithDefault [] "output" ll))- st)- ++ "}}"- else "")))-templateProcessor st ("cite web", ll) = (st, mainer)- where mainer- = "\\myhref{" ++- url ++- "}{" ++- title ++ "}. " ++ publisher ++ ". Retrieved " ++ accessdate ++ " "- url = shallowFlatten (Map.findWithDefault [] "url" ll)- publisher = treeToLaTeX (Map.findWithDefault [] "publisher" ll) st- title = treeToLaTeX (Map.findWithDefault [] "title" ll) st- accessdate- = treeToLaTeX (Map.findWithDefault [] "accessdate" ll) st-templateProcessor st ("code", ll) = (st, mainer)- where - mainer :: String- mainer- = "\\TemplateCode{" ++- header ++- "}{" ++ "}{" ++ "}{" ++ "}{" ++ lang ++ "}{" ++ code ++ "}{}{}{}"- - header :: String- header- = if Map.member "header" ll then- (treeToLaTeX (Map.findWithDefault [] "header" ll)- st{getInCode = True})- else ""- - lang :: String- lang- = if Map.member "lang" ll then- (treeToLaTeX (Map.findWithDefault [] "lang" ll)- st{getInCode = True})- ++ " Source"- else ""- - code :: String- code = trilexgen st{getInCode = True} ll "source"-templateProcessor st ("Java_Code_File", ll) = (st, mainer)- where - mainer :: String- mainer- = "\\TemplateCode{" ++- header ++- "}{" ++ "}{" ++ "}{" ++ "}{" ++ lang ++ "}{" ++ code ++ "}{}{}{}"- - header :: String- header- = if Map.member "header" ll then- (treeToLaTeX (Map.findWithDefault [] "header" ll)- st{getInCode = True})- else ""- - lang :: String- lang = if Map.member "lang" ll then "Java Source" else ""- - code :: String- code = trilexgen st{getInCode = True} ll "source"-templateProcessor st ("Syntax", ll) = (st, mainer)- where - mainer :: String- mainer- = "\\begin{TemplateCodeInside}{}{\\baselineskip}{\\baselineskip}{}{}{}\n"- ++ code ++ "\n\\end{TemplateCodeInside}\n"- - code :: String- code = trilex st{getInCode = True} ll-templateProcessor st ("HaskellGHCi", ll) = (st, mainer)- where - mainer :: String- mainer- = "\\begin{TemplateCodeInside}{}{\\baselineskip}{\\baselineskip}{}{}{}\n"- ++ code ++ "\n\\end{TemplateCodeInside}\n"- - code :: String- code = trilexgen st{getInCode = True} ll "1"-templateProcessor st ("Java://", ll) = (st, mainer)- where - mainer :: String- mainer- = "\\begin{TemplateCodeInside}{}{\\baselineskip}{\\baselineskip}{}{}{}\n"- ++ code ++ "\n\\end{TemplateCodeInside}\n"- - code :: String- code = trilexgen st{getInCode = True} ll "1"-templateProcessor st ("LaTeX/Usage", ll)- = (st2,- if (getInTab st > 0) then "\\TemplateSource{" ++ (rtrim x) ++ "}\n"- else g)- where f = shallowFlatten- (map renormalize- (breakLines3 linewidth (Map.findWithDefault [] "code" ll)))- g = (formatLaTeXBlock defaultFormatOpts) (highlightAs "Latex" f)- (x, st2)- = runState (treeToLaTeX2 (breakLines3 linewidth (map C f))) st-templateProcessor st ("LaTeX/Example", ll)- = (st2,- "\\begin{longtable}{p{1.0\\linewidth}}\n" ++- g ++ "\\\\\n" ++ x ++ "\n\\end{longtable}")- where f = shallowFlatten- (map renormalize- (breakLines3 linewidth (Map.findWithDefault [] "code" ll)))- g = (formatLaTeXBlock defaultFormatOpts) (highlightAs "Latex" f)- (x, st2)- = runState (treeToLaTeX2 (Map.findWithDefault [] "render" ll)) st-templateProcessor st ("java://", ll) = (st, mainer)- where - mainer :: String- mainer- = "\\begin{TemplateCodeInside}{}{\\baselineskip}{\\baselineskip}{}{}{}\n"- ++ code ++ "\n\\end{TemplateCodeInside}\n"- - code :: String- code = trilexgen st{getInCode = True} ll "1"-templateProcessor st ("java", ll) = (st, mainer)- where - mainer :: String- mainer- = "\\begin{TemplateCodeInside}{}{\\baselineskip}{\\baselineskip}{}{}{}\n"- ++ code ++ "\n\\end{TemplateCodeInside}\n"- - code :: String- code = trilex st{getInCode = True} ll-templateProcessor st ("DOI", ll)- = (st,- "DOI:\\myhref{http://dx.doi.org/" ++ tl ++ "}{" ++ tx ++ "}")- where tx = (treeToLaTeX (Map.findWithDefault [] "1" ll) st)- tl = (shallowFlatten (Map.findWithDefault [] "1" ll))-templateProcessor st ("ISSN", ll)- = (st,- "\\myhref{http://dispatch.opac.d-nb.de/DB=1.1/CMD?ACT=SRCHA&IKT=8&TRM="- ++ tl ++ "}{ISSN: " ++ tl ++ "}")- where tl = (shallowFlatten (Map.findWithDefault [] "1" ll))-templateProcessor st ("cpp", ll)- = (st,- ("{\\ttfamily " ++- (treeToLaTeX (breakLines3 96 (Map.findWithDefault [] "1" ll)) st)- ++ "}"))-templateProcessor st ("Schach: Vorlage:Schachbrett", _)- = (st{getC = ((getC st) + 1)},- "\n\n\\parbox[t]{" ++- mysize ++- "\\linewidth}{\n\\begin{center}\n" ++- "\\includegraphics[width=" ++- mysize ++- "\\linewidth,height=6.5in,keepaspectratio]{../images/chess" ++- n ++- ".pdf}\\end{center}\n" ++- "Stellung " ++ n ++ "}\\vspace{0.75cm}\n\n")- where mysize = printf "%0.5f" (getF st)- n = show (getC st)-templateProcessor st ("Farblegende", ll)- = (st,- if p then "\\legendColorBox" ++ col ++ "{" ++ param2 ++ "}\n" else- "\\legendNamedColorBox{" ++ colname ++ "}{" ++ param2 ++ "}\n")- where (p, colname, col)- = colinfo (treeToLaTeX (Map.findWithDefault [] "1" ll) st)- param2 = (treeToLaTeX (Map.findWithDefault [] "2" ll) st)-templateProcessor st ("Farbe", ll) = (st, defineall ++ inside)- where (pred1, colname1, col1) = colinfo (param "1")- (pred2, colname2, col2) = colinfo (param "2")- param n = (treeToLaTeX (Map.findWithDefault [] n ll) st)- trans = ((param "2") == "transparent")- define p colname col- = (if p then "\\definecolor{" ++ colname ++ "}{rgb}" ++ col else- "")- defineall- = (define pred1 colname1 col1) ++ (define pred2 colname2 col2)- inside- = if trans then- "\\textcolor{" ++ colname1 ++ "}{" ++ (param "3") ++ "}" else- "\\fcolorbox{" ++- colname2 ++- "}{" ++- colname2 ++- "}{\\textcolor{" ++ colname1 ++ "}{" ++ (param "3") ++ "}}"-templateProcessor st ("cite paper", ll)- = (st,- (if Map.member "editor" ll then- (treeToLaTeX (Map.findWithDefault [] "editor" ll) st) else- (treeToLaTeX (Map.findWithDefault [] "author" ll) st))- ++- (if Map.member "coauthor" ll then- "; " ++ (treeToLaTeX (Map.findWithDefault [] "coauthor" ll) st)- else "")- ++- " " ++- (treeToLaTeX (Map.findWithDefault [] "date" ll) st) ++- ". " ++- (treeToLaTeX (Map.findWithDefault [] "title" ll) st) ++- "- " ++- (treeToLaTeX (Map.findWithDefault [] "publisher" ll) st) ++- ". pp. " ++- (treeToLaTeX (Map.findWithDefault [] "pages" ll) st) ++ "\n")-templateProcessor st ("Cite book", ll)- = (st,- (if Map.member "editor" ll then- (treeToLaTeX (Map.findWithDefault [] "editor" ll) st) else- (treeToLaTeX (Map.findWithDefault [] "author" ll) st))- ++- " " ++- (treeToLaTeX (Map.findWithDefault [] "title" ll) st) ++- ". " ++- (treeToLaTeX (Map.findWithDefault [] "publisher" ll) st) ++- ", " ++- (treeToLaTeX (Map.findWithDefault [] "address" ll) st) ++- ", " ++- (treeToLaTeX (Map.findWithDefault [] "year" ll) st) ++ "\n")-templateProcessor st ("cite book", ll)- = (st,- (if Map.member "editor" ll then- (treeToLaTeX (Map.findWithDefault [] "editor" ll) st) else- (treeToLaTeX (Map.findWithDefault [] "author" ll) st))- ++- " " ++- (treeToLaTeX (Map.findWithDefault [] "title" ll) st) ++- ". " ++- (treeToLaTeX (Map.findWithDefault [] "publisher" ll) st) ++- ", " ++- (treeToLaTeX (Map.findWithDefault [] "address" ll) st) ++- ", " ++- (treeToLaTeX (Map.findWithDefault [] "year" ll) st) ++ "\n")-templateProcessor st ("Cite article", ll)- = (tempProcAdapter $ citearticle ll) st-templateProcessor st ("cite journal", ll)- = (tempProcAdapter $ citearticle ll) st-templateProcessor st ("citation", ll)- = (tempProcAdapter $ citearticle ll) st-templateProcessor st ("cite newsgroup", ll)- = (tempProcAdapter $ citearticle ll) st-templateProcessor st ("Ada/95/cite AI", ll)- = (tempProcAdapter $ citearticle ll) st-templateProcessor st ("Ada/Cite cla", ll)- = (tempProcAdapter $ citearticle ll) st-templateProcessor st ("cite", ll)- = (tempProcAdapter $ citearticle ll) st-templateProcessor st ("Druckversionsnotiz", _) = (st, "")-templateProcessor st ("Wikipedia", ll)- = (st,- wikiLinkToLaTeX- ((C 'w') : (C ':') : (Map.findWithDefault [] "1" ll))- st)-templateProcessor st ("Wikipedia2", ll)- = (st,- (wikiLinkToLaTeX- ((C 'w') : (C ':') : (Map.findWithDefault [] "1" ll))- st)- ++- (wikiLinkToLaTeX- ((C 'w') : (C ':') : (Map.findWithDefault [] "2" ll))- st)- )-templateProcessor st ("GLSL Programming Unity SectionRef", ll)- = (st,- wikiLinkToLaTeX ((map (C) xx) ++ (Map.findWithDefault [] "1" ll))- st)- where xx- = if- shallowFlatten (Map.findWithDefault [] "1" ll) `elem`- ["OpenGL ES 2.0 Pipeline", "Vertex Transformations",- "Vector and Matrix Operations", "Applying Matrix Transformations",- "Rasterization", "Per-Fragment Operations"]- then "GLSL Programming/" else "GLSL Programming/Unity/"-templateProcessor st ("S", ll)- = (st,- wikiLinkToLaTeX- (((C 's') : (C ':') : (Map.findWithDefault [] "1" ll)) ++- [C '|'] ++ (Map.findWithDefault [] "2" ll))- st)-templateProcessor st ("wikipedia", ll)- = (st,- wikiLinkToLaTeX- ((C 'w') : (C ':') : (Map.findWithDefault [] "1" ll))- st)-templateProcessor st ("Wikiversity", ll)- = (st,- wikiLinkToLaTeX- ((C 'v') : (C ':') : (Map.findWithDefault [] "1" ll))- st)-templateProcessor st ("wikiquote", ll)- = (st,- wikiLinkToLaTeX- ((C 'q') : (C ':') : (Map.findWithDefault [] "1" ll))- st)-templateProcessor st ("W", ll)- = (st,- wikiLinkToLaTeX- ((C 'w') : (C ':') : (Map.findWithDefault [] "1" ll))- st)-templateProcessor st ("wp", ll)- = (st,- wikiLinkToLaTeX- ((C 'w') : (C ':') : (Map.findWithDefault [] "1" ll))- st)-templateProcessor st ("B", ll)- = (st,- wikiLinkToLaTeX- ((C 'b') : (C ':') : (Map.findWithDefault [] "1" ll))- st)-templateProcessor st ("Wikipedia-inline", ll)- = (st,- wikiLinkToLaTeX- ((C 'w') : (C ':') : (Map.findWithDefault [] "1" ll))- st)-templateProcessor st ("B3D:N2P/VTT1", ll) = (st2, r)- where (r, st2)- = runState- (wikiImageToLaTeX- ((C 'F') :- (C 'i') :- (C 'l') :- (C 'e') :- (C ':') :- (Map.findWithDefault [] "image" ll) ++- [C '|'] ++- (Map.findWithDefault [] "imageWidth" ll) ++- [C '|'] ++ (Map.findWithDefault [] "text3" ll)))- st-templateProcessor st ("Template:B3D:N2P/VTT1", ll) = (st2, r)- where (r, st2)- = runState- (wikiImageToLaTeX- ((C 'F') :- (C 'i') :- (C 'l') :- (C 'e') :- (C ':') :- (Map.findWithDefault [] "image" ll) ++- [C '|'] ++- (Map.findWithDefault [] "imageWidth" ll) ++- [C '|'] ++ (Map.findWithDefault [] "text3" ll)))- st-templateProcessor st ("Vorlage:Referenzen Zitat", ll) = (st, r)- where r = (wikiLinkToLaTeX- ((Map.findWithDefault [] "1" ll) ++- [C '|', C '['] ++ (Map.findWithDefault [] "2" ll) ++ [C ']'])- st)-templateProcessor st ("Referenzen Zitat", ll) = (st, r)- where r = (wikiLinkToLaTeX- ((Map.findWithDefault [] "1" ll) ++- [C '|', C '['] ++ (Map.findWithDefault [] "2" ll) ++ [C ']'])- st)-templateProcessor st ("wikipediapar", ll)- = (st,- wikiLinkToLaTeX- ((C 'w') :- (C ':') :- (Map.findWithDefault [] (if Map.member "2" ll then "2" else "1")- ll))- st)-templateProcessor st ("Wikipediapar", ll)- = (st,- wikiLinkToLaTeX- ((C 'w') :- (C ':') :- (Map.findWithDefault [] (if Map.member "2" ll then "2" else "1")- ll))- st)-templateProcessor st ("Druckversion Titeleintrag", ll)- = (st,- "\\pagebreak{}\\begin{longtable}{|p{0.3\\linewidth}|p{0.7\\linewidth}|}\\hline\n"- ++- "\\multicolumn{2}{|p{1.0\\linewidth}|}{\\bfseries Standardtiteleintrag}"- ++- (if (Map.member "URL" ll) then- "\\\\ \\hline\n \\fetchurlcaption & \\url{" ++- (treeToLaTeX (Map.findWithDefault [] "URL" ll) st) ++ "}"- else "")- ++- (if (Map.member "Buch" ll) then- "\\\\ \\hline\n \\bookcaption & \\url{http://de.wikibooks.org/wiki/"- ++- replace2 (treeToLaTeX (Map.findWithDefault [] "Buch" ll) st) " "- "_"- ++ "}"- else "")- ++- (if (Map.member "Sachgruppen" ll) then- "\\\\ \\hline\n \\functionalgroupcaption & " ++- (treeToLaTeX (Map.findWithDefault [] "Sachgruppen" ll) st)- else "")- ++- (if (Map.member "WeitereThemen" ll) then- "\\\\ \\hline\n \\futhertopicscaption & " ++- (treeToLaTeX (Map.findWithDefault [] "WeitereThemen" ll) st)- else "")- ++- (if (Map.member "Hauptautoren" ll) then- "\\\\ \\hline\n \\mainauthorscaption & " ++- (treeToLaTeX (Map.findWithDefault [] "Hauptautoren" ll) st)- else "")- ++- (if (Map.member "Betreuer" ll) then- "\\\\ \\hline\n \\projecttexniciancaption & " ++- (treeToLaTeX (Map.findWithDefault [] "Betreuer" ll) st)- else "")- ++- "\\\\ \\hline\n \\organizationscaptions & Wikibooks" ++- (if (Map.member "Erscheinungsdatum" ll) then- "\\\\ \\hline\n \\datecaption & " ++- (treeToLaTeX (Map.findWithDefault [] "Erscheinungsdatum" ll) st)- else "")- ++- (if (Map.member "Standardnummer" ll) then- "\\\\ \\hline\n \\standardcodecaption & " ++- (treeToLaTeX (Map.findWithDefault [] "Standardnummer" ll) st)- else "")- ++- (if (Map.member "Buch" ll) then- "\\\\ \\hline\n \\maintitlecaption & " ++- (treeToLaTeX (Map.findWithDefault [] "Buch" ll) st)- else "")- ++- (if (Map.member "Verleger" ll) then- "\\\\ \\hline\n \\publishercaption & " ++- (treeToLaTeX (Map.findWithDefault [] "Verleger" ll) st)- else "")- ++- (if (Map.member "Verlagsort" ll) then- "\\\\ \\hline\n \\publishercitycaption & " ++- (treeToLaTeX (Map.findWithDefault [] "Verlagsort" ll) st)- else "")- ++- (if (Map.member "Regal" ll) then- "\\\\ \\hline\n \\shelfcaption & " ++- (treeToLaTeX (Map.findWithDefault [] "Regal" ll) st)- else "")- ++- (if (Map.member "Umfang" ll) then- "\\\\ \\hline\n \\sizecaption & " ++- (treeToLaTeX (Map.findWithDefault [] "Umfang" ll) st)- else "")- ++ "\\\\ \\hline \n\\end{longtable}\n")-templateProcessor st ("Druckversion Titelseite", ll)- = (st{getTitle = s}, s)- where s = (if (Map.member "Haupttitel" ll) then- "\\mymaintitle{" ++- (treeToLaTeX (Map.findWithDefault [] "Haupttitel" ll)- st{getInCenter = True})- ++ "}"- else "")- ++- (if (Map.member "Untertitel" ll) then- "\\mysubtitle{" ++- (treeToLaTeX (Map.findWithDefault [] "Untertitel" ll)- st{getInCenter = True})- ++ "}"- else "")- ++- (if (Map.member "Autor" ll) then- "\\myauthor{" ++- (treeToLaTeX (Map.findWithDefault [] "Autor" ll)- st{getInCenter = True})- ++ "}"- else "")-templateProcessor st ('j' : ('a' : ('v' : ('a' : (':' : xs)))), ll)- = (tempProcAdapter $ javakeyword xs ll "java:") st-templateProcessor st ('J' : ('a' : ('v' : ('a' : (':' : xs)))), ll)- = (tempProcAdapter $ javakeyword xs ll "Java:") st-templateProcessor st ("Haskell lib", ll)- = (st, linkToLaTeX link st "")- where - param :: String -> Maybe [Anything Char]- param name = Map.lookup name ll- package- = fromMaybe (map (C) "base") $ param "p" `mplus` param "package"- version- = fromMaybe (map (C) "4.1.0.0") $ param "v" `mplus` param "version"- - unnamed :: Integer -> [Anything Char]- unnamed i = fromMaybe [] $ param (show i)- unnPars = takeWhile (not . null) $ map unnamed [1 ..]- location- = (map (C) "http://hackage.haskell.org/packages/archive/") ++- package ++- [C '/'] ++- version ++- (map (C) "/doc/html/") ++- (intercalate [C '-'] unnPars) ++ (map (C) ".html")- caption = intercalate [C '.'] unnPars- link = location ++ [C ' '] ++ caption-templateProcessor st ("V", ll)- = (st,- wikiLinkToLaTeX- ((C 'v') : (C ':') : (Map.findWithDefault [] "1" ll))- st)-templateProcessor st ("wikisource", ll)- = (st,- wikiLinkToLaTeX- ((C 's') : (C ':') : (Map.findWithDefault [] "1" ll))- st)-templateProcessor st ("M", ll)- = (st,- wikiLinkToLaTeX- ((C 'm') : (C ':') : (Map.findWithDefault [] "1" ll))- st)-templateProcessor st ("C", ll)- = (st,- "\\myhref{http://commons.wikimedia.org/wiki/" ++- loc ++ "}{" ++ cap ++ "}")- where loc = (shallowFlatten (Map.findWithDefault [] "1" ll))- - cap :: String- cap- = if (Map.member "2" ll) then- (treeToLaTeX (Map.findWithDefault [] "2" ll) st) else- (treeToLaTeX (Map.findWithDefault [] "1" ll) st)-templateProcessor st ("commons", ll)- = (st,- "\\myhref{http://commons.wikimedia.org/wiki/" ++- loc ++ "}{" ++ cap ++ "}")- where loc = (shallowFlatten (Map.findWithDefault [] "1" ll))- - cap :: String- cap- = if (Map.member "2" ll) then- (treeToLaTeX (Map.findWithDefault [] "2" ll) st) else- (treeToLaTeX (Map.findWithDefault [] "1" ll) st)-templateProcessor st ("Commonscat", ll)- = (st,- "\\myhref{http://commons.wikimedia.org/wiki/Category:" ++- loc ++ "}{" ++ cap ++ "}")- where loc = (shallowFlatten (Map.findWithDefault [] "1" ll))- - cap :: String- cap- = if (Map.member "2" ll) then- (treeToLaTeX (Map.findWithDefault [] "2" ll) st) else- (treeToLaTeX (Map.findWithDefault [] "1" ll) st)-templateProcessor st ("Commons", ll)- = (st,- "\\myhref{http://commons.wikimedia.org/wiki/" ++- loc ++ "}{" ++ cap ++ "}")- where loc = (shallowFlatten (Map.findWithDefault [] "1" ll))- - cap :: String- cap- = if (Map.member "2" ll) then- (treeToLaTeX (Map.findWithDefault [] "2" ll) st) else- (treeToLaTeX (Map.findWithDefault [] "1" ll) st)-templateProcessor st ("b", ll)- = (st,- wikiLinkToLaTeX- ((C 'b') : (C ':') : (Map.findWithDefault [] "1" ll))- st)-templateProcessor st ("Wikiquote", ll)- = (st,- wikiLinkToLaTeX- ((C 'q') : (C ':') : (Map.findWithDefault [] "1" ll))- st)-templateProcessor st ("Wikisource", ll)- = (st,- wikiLinkToLaTeX- ((C 's') : (C ':') : (Map.findWithDefault [] "1" ll))- st)-templateProcessor st ("Reaktion", ll)- = (st, edukte ++ " $\\rightarrow$ " ++ produkte)- where - reput :: [String] -> [[Anything Char]] -> [[Anything Char]]- reput (k : ks) out- = if Map.member k ll then- reput ks ((Map.findWithDefault [] k ll) : out) else reput ks out- reput [] out = out- - myjoin :: [[Anything Char]] -> String -> String- myjoin (x : xs) acu- = if xs == [] then- (if acu == "" then (treeToLaTeX x st) else- acu ++ "+" ++ (treeToLaTeX x st))- else- (if acu == "" then myjoin xs (treeToLaTeX x st) else- myjoin xs acu ++ "+" ++ (treeToLaTeX x st))- myjoin [] acu = acu- edukte- = myjoin (reput ["Edukt", "Edukt1", "Edukt2", "Edukt3"] []) ""- produkte- = myjoin (reput ["Produkt", "Produkt1", "Produkt2", "Produkt3"] [])- ""-templateProcessor st ("Visual Basic .NET: Vorlage:Code", ll)- = templateProcessor st ("C++-Programmierung/ Vorlage:Code", ll)-templateProcessor st ("Regal:Programmierung: Vorlage:Code", ll)- = (st, mainer)- where - mainer :: String- mainer- = "\\TemplateCode{" ++- header ++- "}{" ++- footer ++- "}{" ++- marker ++- "}{}{" ++ output ++ "}{" ++ lang ++ "}{" ++ code ++ "}{}{}{}"- - marker :: String- marker- = if Map.member "error" ll then "e" else- if Map.member "valid" ll then "valid" else ""- - header :: String- header- = if Map.member "kopf" ll then- (treeToLaTeX (Map.findWithDefault [] "kopf" ll)- st{getInCode = True})- else ""- - lang :: String- lang- = if Map.member "lang" ll then- (treeToLaTeX (Map.findWithDefault [] "lang" ll)- st{getInCode = True})- ++ " Quelltext"- else ""- - code :: String- code = trilex st{getInCode = True} ll- - output :: String- output- = if Map.member "output" ll then- (treeToLaTeX (killnbsp (Map.findWithDefault [] "output" ll))- st{getInCode = True})- else ""- - footer :: String- footer- = if Map.member "fuss" ll then- (treeToLaTeX (Map.findWithDefault [] "fuss" ll)- st{getInCode = True})- else ""- killnbsp ((Environment HtmlChar (Str "nbsp") _) : xs) = xs- killnbsp x = x-templateProcessor st (x, ll)- = (tempProcAdapter $ unknownTemplate x ll) st- -{-DHUN| This function is currently nearly unused, it is essentially the same as templateProcessor. But with this way of writing it down you can find out for which templates handler functions are registered. DHUN-}- -templateRegistry ::- [(String, Map String [Anything Char] -> Renderer String)]-templateRegistry- = [("Regal:Programmierung: Vorlage:Code",- \ ll ->- let - marker :: String- marker- = if Map.member "error" ll then "e" else- if Map.member "valid" ll then "valid" else ""- killnbsp ((Environment HtmlChar (Str "nbsp") _) : xs) = xs- killnbsp x = x- withdef x f- = if Map.member x ll then- (treeToLaTeX2 (f (Map.findWithDefault [] x ll))) else return ""- in- do st <- get- put $ st{getInCode = True}- code <- trilex2 ll- footer <- withdef "fuss" id- header <- withdef "kopf" id- lang <- do x <- (withdef "lang" id)- return $ if x == "" then "" else x ++ " Quelltext"- output <- withdef "output" killnbsp- st2 <- get- put $ st2{getInCode = False}- return $- "\\TemplateCode{" ++- header ++- "}{" ++- footer ++- "}{" ++- marker ++- "}{" ++ output ++ "}{" ++ lang ++ "}{" ++ code ++ "}{}{}{}")]- -{-DHUN| processing of Java keywords for the English wikibook on Java, each Java keyword got its own template there DHUN-}- -javakeyword ::- [Char] -> Map String [Anything Char] -> [Char] -> Renderer String-javakeyword xs ll j- = if (xs `elem` keywords) then- state $ \ st -> ("{\\bfseries " ++ xs ++ "}", st) else- unknownTemplate (j ++ xs) ll- where keywords- = (["private", "int", "return", "void", "new", "class",- "interface", "String", "null", "Object", "byte", "char", "short",- "long", "double", "boolean", "if", "true", "static", "public",- "protected", "extends", "throw", "catch", "throws", "try",- "abstract", "false", "else", "switch", "continue", "import",- "final", "break", "implements", "finally", "while", "string",- "float", "do", "for", "case", "default", "package", "this"])- -{-DHUN| Handler for the unknown template. That is the ones that no handler was registered for DHUN-}- -unknownTemplate ::- String -> Map String [Anything Char] -> Renderer String-unknownTemplate xx ll2- = do st <- get- let x = trim xx- ll = Map.fromList (trimall (Map.toList ll2))- trimall ((a, b) : xs) = ((trim a), b) : (trimall xs)- trimall [] = []- tm = (templateMap st)- step_ttl y = treeToLaTeX2 (Map.findWithDefault [] y ll)- maybe_known_sf- = do lis <- Map.lookup x tm- guard (not $ null lis)- let (latexname : transparams) = lis- guard (latexname /= "")- return $- do out <- mapM step_ttl transparams- return $- "\\" ++- latexname ++ "{" ++ (intercalate "}{" (map trim out)) ++ "}"- unknown_sf- = do uparams <- mapM step_ttl $ Map.keys ll- return $- "\n\nUNKNOWN TEMPLATE \n" ++- (drop 1 . nullinit $ show x) ++- "\n\n" ++ "{" ++ (intercalate "}{" uparams) ++ "}" ++ "\n\n"- in fromMaybe unknown_sf maybe_known_sf- -{-DHUN| helper function to generate image numbers for image in image galleries (gallery tag in mediawiki) the fist input parameter is the start number, the second the end number. A list of all numbers between start and end is returned DHUN-}- -generateGINsHelper :: Int -> Int -> [Int]-generateGINsHelper b e- = if b == e then [] else b : (generateGINsHelper (b + 1) e)- -{-DHUN| function to generate image numbers for image in image galleries (gallery tag in mediawiki). The renderer start before the start of the gallery is given as first parameter. The state of the renderer after the end of the gallery is given as second parameter. A list containing the numbers of the images in the gallery is returned DHUN-}- -generateGalleryImageNumbers :: MyState -> MyState -> [Int]-generateGalleryImageNumbers oldst newst- = generateGINsHelper (getJ oldst) (getJ newst)- -{-DHUN| strips center tags of the parse tree keeping the data inside the center tags in the parse tree, so just flattens out the center tags DHUN-}- -uncenter :: [Anything t] -> [Anything t]-uncenter ((Environment Tag (TagAttr "center" _) l) : xs)- = l ++ (uncenter xs)-uncenter ((Environment e s l) : xs)- = (Environment e s (uncenter l)) : (uncenter xs)-uncenter (x : xs) = x : (uncenter xs)-uncenter [] = []- -{-DHUN| converts a parse tree to latex. Takes the parse tree as first parameter. Takes the current state of the renderer as second input parameter. Returns the latex representation of the tree as return value. This function should only be used internally in latex renderer since it does not generate the table of names references for the ref tags. DHUN-}- -treeToLaTeX :: [Anything Char] -> MyState -> String-treeToLaTeX l states = fst $ runState (treeToLaTeX2 l) states- -{-DHUN| converts a parse tree to latex. Takes the parse tree as first parameter. Takes the current state of the renderer as second input parameter. Returns a tuple. the first element is the latex representation of the tree. The second is the new state of the renders. Does one run before the actual run, in order to generate a table of names references for the ref tags in mediawiki. This function should be called by the main program after the parser. DHUN-}- -treeToLaTeX3 :: [Anything Char] -> MyState -> (String, MyState)-treeToLaTeX3 l st = runState ttl2twice st- where ttl2twice- = do _ <- treeToLaTeX2 l- b <- get- put st{fndict = fndict b}- treeToLaTeX2 l- -{-DHUN| converts a parse tree to latex. Takes the parse tree as first parameter. Takes the current state of the renderer as second input parameter. Returns the latex representation of the tree as Renderer String. So it actually takes the current state of the renderer as additional monadic input parameter and returns a possible modified version of it as additional monadic return parameter. This function should only be used internally in latex renderer since it does not generate the table of names references for the ref tags. DHUN-}- -treeToLaTeX2 :: [Anything Char] -> Renderer String-treeToLaTeX2 ll- = do x <- allinfo- return $ concat x- where - allinfo :: Renderer [String]- allinfo = mapM nodeToLaTeX (removeBr ll)- - walk :: String -> [Anything Char] -> String -> Renderer String- walk prefix l postfix- = do d <- treeToLaTeX2 l- return $ prefix ++ d ++ postfix- - walktrim :: String -> [Anything Char] -> String -> Renderer String- walktrim prefix l postfix- = do st <- get- put $ st{getInHeading = True}- d <- treeToLaTeX2 l- st2 <- get- put $ st2{getInHeading = getInHeading st}- return $ prefix ++ (trim d) ++ postfix- - walkbf :: [Anything Char] -> Renderer String- walkbf l- = do st <- get- put $- st{fontStack =- ((fromMaybe- FontStyle{stylebase = Normal, bold = True, italic = False}- (maybeHead (fontStack st))){bold = True}- : (fontStack st))}- d <- treeToLaTeX2 l- st2 <- get- put $ st2{fontStack = drop 1 (fontStack st2)}- return $ "{\\bfseries " ++ (trim d) ++ "}"- - walkit :: [Anything Char] -> Renderer String- walkit l- = do st <- get- put $- st{fontStack =- ((fromMaybe- FontStyle{stylebase = Normal, bold = False, italic = True}- (maybeHead (fontStack st))){italic = True}- : (fontStack st))}- d <- treeToLaTeX2 l- st2 <- get- put $ st2{fontStack = drop 1 (fontStack st2)}- return $ "{\\itshape " ++ (trim d) ++ "}"- - walktt :: [Anything Char] -> Renderer String- walktt l- = do st <- get- put $- st{fontStack =- ((fromMaybe- FontStyle{stylebase = Mono, bold = False, italic = False}- (maybeHead (fontStack st))){stylebase = Mono}- : (fontStack st))}- d <- treeToLaTeX2 l- st2 <- get- put $ st2{fontStack = drop 1 (fontStack st2)}- return $ "{\\ttfamily " ++ (trim d) ++ "}"- - walkfn :: String -> [Anything Char] -> String -> Renderer String- walkfn prefix l postfix- = do st <- get- put $ st{getInFootnote = True}- d <- treeToLaTeX2 l- st2 <- get- put $ st2{getInFootnote = (getInFootnote st)}- return $ prefix ++ d ++ postfix- - nodeToLaTeX :: Anything Char -> Renderer String- nodeToLaTeX (C c)- = do st <- get- case (fontStack st) of- (x : _) -> if (getFont x c) == (font st) then return (chartrans c)- else- do put st{font = (getFont x c)}- return- ((fontsetter (getFont x c)) ++ (fontstyler x) ++ (chartrans c))- _ -> return (chartrans c)- nodeToLaTeX (Environment ForbiddenTag (Str s) _)- = return $ s >>= chartrans- nodeToLaTeX (Environment Wikitable (Str s) l)- = do st <- get- put $ st{getInTab = (getInTab st) + 1}- d <- tableToLaTeX l s- st2 <- get- put $ st2{getInTab = (getInTab st)}- return d- nodeToLaTeX (Environment Wikitable (TagAttr _ a) l)- = do st <- get- put $ st{getInTab = (getInTab st) + 1}- d <- tableToLaTeX l- (if- (Map.lookup "class" a) `elem`- (map Just ["prettytable", "wikitable"])- then "class=\"wikitable\"" else "")- st2 <- get- put $ st2{getInTab = (getInTab st)}- return d- nodeToLaTeX (Environment Wikilink _ l)- = do st <- get- if getInHeading st then return $ wikiLinkCaption l st else- if (isImage (shallowFlatten l)) then wikiImageToLaTeX l else- return $ wikiLinkToLaTeX l st- nodeToLaTeX (Environment Link (Str s) l)- = do st <- get- if getInHeading st then- return $ linkCaption l st s (getInFootnote st) else- return $ linkToLaTeX l st s- nodeToLaTeX (Environment Link2 (Str s) l)- = nodeToLaTeX (Environment Link (Str s) l)- nodeToLaTeX (Environment ItemEnv (Str _) [Item _]) = return []- nodeToLaTeX (Environment ItemEnv (Str s) l)- = do st <- get- d <- if s == ";" then do fulllist else- do ff <- treeToLaTeX2- (if- (s == ":") &&- ([] ==- [x | x <- l,- not- ((case x of- Environment Math _ _ -> True- Item _ -> True- _ -> False)- || (x `elem` (map (C) "\n\t \r;,.")))])- then- (shallowEnlargeMath- [x | x <- l, not (x `elem` (map (C) "\n\t \r;,.:!?"))])- else l)- return [(ff, "")]- if s /= ";" then- return $- "\n\\begin{" ++- (itemEnvironmentName s (getF st)) ++- "}" ++- (itemEnvironmentParameters s (getF st)) ++- (mmm2 d) ++- "\n\\end{" ++ (itemEnvironmentName s (getF st)) ++ "}\n"- else return $ (prolist d st)- where mmm2 d- = case d of- (x : _) -> fst x- _ -> []- texit v- = do prep <- treeToLaTeX2 . prepart $ v- post <- treeToLaTeX2 . postpart $ v- return (prep, post)- - fulllist :: Renderer [(String, String)]- fulllist = mapM texit vv- - vv :: [[Anything Char]]- vv = [x | x <- splitOn [Item ';'] l, x /= []]- prepart v = takeWhile ((/=) (C ':')) v- postpart v- = case dropWhile ((/=) (C ':')) v of- (_ : xs) -> xs- x -> x- - prolist :: [(String, String)] -> MyState -> String- prolist lis st- = do (prd, pod) <- lis- if pod == [] then (singlepart prd st) else (doublepart prd pod st)- doublepart pre po st- = "{\\bfseries" ++- "\n\\begin{" ++- (itemEnvironmentName s (getF st)) ++- "}" ++- (itemEnvironmentParameters s (getF st)) ++- pre ++- "\n\\end{" ++- (itemEnvironmentName s (getF st)) ++- "}\n" ++- "}" ++- "\n\\begin{" ++- (itemEnvironmentName ":" (getF st)) ++- "}" ++- (itemEnvironmentParameters s (getF st)) ++- (itemEnvironmentParameters s (getF st)) ++- (itemSeperator2 s) ++- po ++- "\n\\end{" ++- (itemEnvironmentName ":" (getF st)) ++ "}\n"- singlepart pre st- = "{\\bfseries" ++- "\n\\begin{" ++- (itemEnvironmentName s (getF st)) ++- "}" ++- (itemEnvironmentParameters s (getF st)) ++- pre ++- "\n\\end{" ++ (itemEnvironmentName s (getF st)) ++ "}\n" ++ "}\n"- nodeToLaTeX (Item c) = return $ "\n" ++ (itemSeperator c) ++ " "- nodeToLaTeX (Environment Itemgroup _ l) = walk "" l ""- nodeToLaTeX (Environment Wikiheading (Str s) l)- = walktrim ("\\" ++ (getsec s) ++ "{") (uncenter l)- ("}\n" ++ (getsecpost s))- nodeToLaTeX (Environment Tag (TagAttr ('h' : (x : [])) _) l)- = if x `elem` "123456" then- case reads [x] of- [] -> walk "" l ""- ((y, _) : _) -> let s = replicate y '=' in- walktrim ("\\" ++ (getsec s) ++ "{") (uncenter l)- ("}\n" ++ (getsecpost s))- else walk "" l ""- nodeToLaTeX (Environment Bold _ l) = walkbf l- nodeToLaTeX (Environment Italic _ l) = walkit l- nodeToLaTeX (Environment Chapter _ l)- = do d <- treeToLaTeX2 l- return $ "\\chapter{" ++ (chapterTransform d) ++ "}\n\\myminitoc\n"- nodeToLaTeX (Environment Tag (TagAttr "sup" _) l)- = do st<-get- walk ((fontsetter (font st))++"\\textsuperscript{") l "}"- nodeToLaTeX (Environment Tag (TagAttr "li" _) l)- = walk "\\item{}" l ""- nodeToLaTeX (Environment Tag (TagAttr "a" d) l)- = do st <- get- if getInHeading st then treeToLaTeX2 l else- case Map.lookup "href" d of- Just g -> return $- linkToLaTeX- ((map (C)- (case g of- '/' : _ -> wikiUrlDataToString (urld st) g- _ -> g))- ++ [C ' '] ++ l)- st- ""- Nothing -> treeToLaTeX2 l- nodeToLaTeX (Environment Tag (TagAttr "ol" _) l)- = do st <- get- walk- ("\n\\begin{" ++- (itemEnvironmentName "#" (getF st)) ++- "}" ++ (itemEnvironmentParameters "#" (getF st)))- l- ("\n\\end{" ++ (itemEnvironmentName "#" (getF st)) ++ "}\n")- nodeToLaTeX (Environment Tag (TagAttr "dd" _) l)- = do st <- get- walk- ("\n\\begin{" ++- (itemEnvironmentName ":" (getF st)) ++- "}" ++ (itemEnvironmentParameters ":" (getF st)) ++ "\n\\item{}")- l- ("\n\\end{" ++ (itemEnvironmentName ":" (getF st)) ++ "}\n")- nodeToLaTeX (Environment Tag (TagAttr "ul" _) l)- = do st <- get- walk- ("\n\\begin{" ++- (itemEnvironmentName "*" (getF st)) ++- "}" ++ (itemEnvironmentParameters "*" (getF st)))- l- ("\n\\end{" ++ (itemEnvironmentName "*" (getF st)) ++ "}\n")- nodeToLaTeX (Environment Tag (TagAttr "dir" _) l)- = do st <- get- walk- ("\n\\begin{" ++- (itemEnvironmentName "*" (getF st)) ++- "}" ++ (itemEnvironmentParameters "*" (getF st)))- l- ("\n\\end{" ++ (itemEnvironmentName "*" (getF st)) ++ "}\n")- nodeToLaTeX (Environment Tag (TagAttr "strong" _) l) = walkbf l- nodeToLaTeX (Environment Tag (TagAttr "dfn" _) l) = walkit l- nodeToLaTeX (Environment Tag (TagAttr "var" _) l) = walkit l- nodeToLaTeX (Environment Tag (TagAttr "q" _) l) = walkit l- nodeToLaTeX (Environment Tag (TagAttr "sub" _) l)- = do st<-get- walk ((fontsetter (font st))++"\\textsubscript{") l "}"- nodeToLaTeX (Environment Tag (TagAttr "cite" _) l)- = walk "\\newline\n \\quad {\\scshape " l "}"- nodeToLaTeX (Environment Sup (Str s) _)- = return $ "{$^{\\textrm{\\scriptsize " ++ s ++ "}}$}"- nodeToLaTeX (Environment Sub (Str s) _)- = return $ "{$_{\\textrm{\\scriptsize " ++ s ++ "}}$}"- nodeToLaTeX (Environment Tag (TagAttr "u" _) l)- = walk "\\uline{" l "}"- nodeToLaTeX (Environment Tag (TagAttr "ins" _) l)- = walk "\\uline{" l "}"- nodeToLaTeX (Environment Tag (TagAttr "del" _) l)- = walk "\\sout{" l "}"- nodeToLaTeX (Environment Tag (TagAttr "strike" _) l)- = walk "\\sout{" l "}"- nodeToLaTeX (Environment Tag (TagAttr "b" _) l) = walkbf l- nodeToLaTeX (Environment Tag (TagAttr "script" _) _)- = walk "" [] ""- nodeToLaTeX (Environment Tag (TagAttr "style" _) _) = walk "" [] ""- nodeToLaTeX (Environment Tag (TagAttr "dt" _) l) = walkbf l- nodeToLaTeX (Environment Tag (TagAttr "i" _) l) = walkit l- nodeToLaTeX (Environment Tag (TagAttr "em" _) l) = walkit l- nodeToLaTeX (Environment Tag (TagAttr "s" _) l)- = walk "\\sout{" l "}"- nodeToLaTeX (Environment Tag (TagAttr "small" _) l)- = do st <- get- if getInHeading st then walk "" l "" else walk "{\\small " l "}"- nodeToLaTeX (Environment Tag (TagAttr "center" _) l)- = do d <- treeToLaTeX2 (shallowEnlargeMath l)- return $ "\n\\begin{center}\n" ++ d ++ "\n\\end{center}\n"- nodeToLaTeX (Environment Tag (TagAttr "ref" a) l)- = do st <- get- case Map.lookup "name" a of- Just n -> case Map.lookup n (fndict st) of- Just lll -> go st lll- Nothing -> if not (and (map (`elem` (map (C) " \r\n\t")) l)) then- do put st{fndict = Map.insert n l (fndict st)}- st2 <- get- go st2 l- else go st l- Nothing -> go st l- where go ss xx- = if getInFootnote ss then walk "\\^{}\\{" xx "\\}" else- walkfn "\\myfootnote{" xx "}"- nodeToLaTeX (Environment Tag (TagAttr "includeonly" _) l)- = walk "" l ""- nodeToLaTeX (Environment Tag (TagAttr "blockquote" _) l)- = walk "\\begin{myblockquote}\n\\item{}" l "\n\\end{myblockquote}"- nodeToLaTeX (Environment Tag (TagAttr "code" _) l) = walktt l- nodeToLaTeX (Environment Tag (TagAttr "kbd" _) l) = walktt l- nodeToLaTeX (Environment Tag (TagAttr "samp" _) l) = walktt l- nodeToLaTeX (Environment Tag (TagAttr "tt" _) l) = walktt l- nodeToLaTeX (Environment Tag (TagAttr "big" _) l)- = do st <- get- if getInHeading st then walk "" l "" else walk "{\\large " l "}"- nodeToLaTeX (Environment Tag (TagAttr "div" a) l)- = let co- = case Map.lookup "style" a of- Nothing -> Nothing- Just x -> case splitOn "background-color:" x of- (_ : (y2 : [])) -> case splitOn ";" y2 of- (z1 : _) -> case (trim z1) of- ('#' : gs) -> let (p,- _,- col)- = colinfo- ('l'- :- 'l'- :- gs)- in- Just $- if p- then- "\\definecolor{shadecolor}{rgb}"- ++- col- else- "\\colorlet{shadecolor}{"- ++- z1- ++- "}"- _ -> Just $- "\\colorlet{shadecolor}{"- ++ z1 ++ "}"- _ -> Nothing- _ -> Nothing- beg- = case co of- Nothing -> ""- Just x -> "\\LaTeXShadedColorBoxTemplate{" ++ x ++ "}{"- en- = case co of- Nothing -> ""- Just _ -> "}"- in- if (Map.member "class" a) then- if (Map.findWithDefault [] "class" a) `elem` ["noprint", "topicon"]- then return $ beg ++ en else walk beg l en- else walk beg l en- nodeToLaTeX (Environment Tag (TagAttr "span" a) l)- = if (Map.member "class" a) then- if- ((Map.findWithDefault [] "class" a) `elem`- ["noprint", "latitude", "longitude", "elevation"])- || ((Map.findWithDefault [] "id" a) `elem` ["coordinates"])- then return "" else walk "" l ""- else walk "" l ""- nodeToLaTeX (Environment Tag (TagAttr "br" _) _)- = do st <- get- return $- if (getInCenter st) then "\\\\" else- if (getInTab st) > 0 then "\\newline{}" else- "$\\text{ }$\\newline{}\n"- nodeToLaTeX (Environment Source (TagAttr _ a) l)- = do let g = case reverse l of- [] -> []- (x : xs) -> if x == (C '\n') then reverse xs else l- let f = shallowFlatten (map renormalize (breakLines3 linewidth l))- d <- treeToLaTeX2 (breakLines3 linewidth g)- st <- get- return $- case- do aa <- Map.lookup "lang" a- guard (not (getInFootnote st))- guard (not ((getInTab st) > 0))- return aa- of- Just j -> '\n' :- replace2- (replace2- (replace2- (replace2- (replace2- (replace2- (replace2- (replace2- (replace2- (replace2- ((formatLaTeXBlock defaultFormatOpts)- (highlightAs j f))- "'"- "\\textquotesingle{}")- "\n"- "\\newline\n")- "{Shaded}\\newline\n"- "{Shaded}\n")- "{Highlighting}[]\\newline\n\\newline\n"- "{Highlighting}[]\n\n")- "{Highlighting}\\newline\n"- "{Highlighting}\n")- " "- "\\ensuremath{\\text{ }}")- "%"- "\\%")- "$"- "\\$")- "{Highlighting}[]\\newline\n"- "{Highlighting}[]\n\n")- "&"- "\\&"- Nothing -> "\\TemplateSource{" ++ (rtrim d) ++ "}\n"- nodeToLaTeX (Environment Tag (TagAttr "font" a) l)- = if Map.member "style" a then- if- ((Map.findWithDefault [] "style" a) == "text-decoration:overline")- then walk "\\myoverline{" l "}" else walk "" l ""- else walk "" l ""- nodeToLaTeX (Environment Tag _ l) = walk "" l ""- nodeToLaTeX (Environment Preformat (TagAttr _ _) l)- = do d <- treeToLaTeX2 (breakLines3 linewidth l)- return $ "\\TemplatePreformat{" ++ d ++ "}"- nodeToLaTeX (Environment DhunUrl _ l)- = do st <- get- put st{currentUrl = shallowFlatten l}- return ""- nodeToLaTeX (Environment NoWiki _ l) = walk "" l ""- nodeToLaTeX (Environment HDevLine _ l) = walk "" l ""- nodeToLaTeX (Environment PageBreak _ _) = return "\\pagebreak "- nodeToLaTeX (Quad) = return "$\\text{ }${}"- nodeToLaTeX (Environment TableCap _ l) = walk "" l ""- nodeToLaTeX (Tab)- = return $ concat (take tabwidth (repeat "${\\text{ }}${}"))- nodeToLaTeX (Environment SpaceIndent _ l)- = if onlySpaces l then return "\n" else- do st <- get- z <- treeToLaTeX2 l- put st- if (all (\ x -> x `elem` "\r\n\t ") z) then return "" else- do d <- treeToLaTeX2 (breakLines3 linewidth l)- return $ (preput st) ++ "\\TemplateSpaceIndent{" ++ d ++ "}\n"- where preput i = if getInCode i then "" else "\\\\\n\n"- nodeToLaTeX (Environment Math _ l) = return $ mathToLatex l- nodeToLaTeX (Environment BigMath _ l)- = return $- "\\begin{equation*}" ++ (mathTransform l) ++ "\\end{equation*}"- nodeToLaTeX (Environment Greek (Str s) _)- = return $ "{\\mbox{$\\" ++ s ++ "$}}"- nodeToLaTeX (Environment P302 (Str s) _)- = return $ "\\^{" ++ s ++ "}"- nodeToLaTeX (Environment HtmlChar (Str s) _)- = return $ getHtmlChar s- nodeToLaTeX (Environment NumHtml (Str s) _)- = return $- case reads s of- [] -> case- do z <- case s of- ('x' : xs) -> Just xs- ('X' : xs) -> Just xs- _ -> Nothing- g <- unhex z- return g- of- Just x -> chartrans . chr . fromIntegral $ x- Nothing -> ("&#" ++ s ++ ";") >>= chartrans- (x : _) -> chartrans . chr . fst $ x- nodeToLaTeX (Environment Gallery _ l)- = do st <- get- put st{getInGallery = True}- d <- galleryToLatex l- st2 <- get- put $ (newst st2){getInGallery = (getInGallery st)}- return d- where midst i = i{getInGallery = False}- gins i = generateGalleryImageNumbers i (midst i)- newst i- = (midst i){getGalleryNumbers =- (getGalleryNumbers (midst i)) ++ (map toInteger (gins i))}- nodeToLaTeX (Environment ImageMap _ l)- = treeToLaTeX2 (imageMapClean l)- nodeToLaTeX (Environment Reserved (Str "·") _)- = return "{\\mbox{$\\cdot$}}"- nodeToLaTeX (Environment Template (Str s) l) = templateToLatex l s- nodeToLaTeX (Environment Label (Str s) _)- = return $ "\\label{" ++ s ++ "}"- nodeToLaTeX _ = return []- -{-DHUN| Unicode escaping for latex strings DHUN-}- ++{-| This modules converts the parse tree to a latex document -}+module LatexRenderer+ (treeToLaTeX3, shallowFlatten, prepateTemplate, replace, doUnicode,+ getGalleryNumbers, getTitle, initialState, getJ, urld,+ analyseNetloc, templateMap, getUserTemplateMap, urls, mUrlState,+ initialUrlState, makeLables, templateRegistry, baseUrl,+ deepFlatten, wikiLinkCaption, imageSize, isCaption, linewidth,+ generateGalleryImageNumbers, splitToTuples, galleryTableScale,+ tempProcAdapter)+ where+import Data.String.HT (trim)+import MyState+import Data.List+import qualified Data.Map as Map+import Data.Map.Strict (Map)+import Data.Char+import Text.Printf+import FontTool+import MediaWikiParseTree+import MagicStrings+import Tools+import Control.Monad.Trans.State+ (State, state, runState, StateT, runStateT, put, get)+import Control.Monad.Trans.Class (lift)+import Control.Monad (guard, mplus, msum)+import TableHelper+import GHC.Float+import Text.Highlighting.Kate+import WikiLinkHelper+import WikiHelper+import Data.List.Split+import BaseFont+import Data.Maybe+import Data.Tuple (swap)+import MediaWikiParser hiding (prep)++{-| the maximum width of lines for preformat and source code -}++linewidth :: Int+linewidth = 80++{-| The user can provide her own translation table for mediawiki templates to latex commands. this is done in the templates.user files. This function takes this file in list representation and converts it to the map representation to be able to look up the names of templates -}++getUserTemplateMap :: [[String]] -> Map String [String]+getUserTemplateMap input+ = Map.fromList (map (\ (x : xs) -> (x, xs)) input)++{-| table may omit tailing columns in a row, but in latex they need to be written out, this function does so -}++rowaddsym :: TableState -> [Char]+rowaddsym st+ = if (currentColumn st) < ((numberOfColumnsInTable st) + 1) then+ (if (currentColumn st) == 1 then+ replicate (((numberOfColumnsInTable st)) - (currentColumn st)) '&'+ else+ replicate (((numberOfColumnsInTable st) + 1) - (currentColumn st))+ '&')+ else []++{-| This function renders the inner parts of a table to latex it does so by calling tableContentToLaTeX and additionally removes superfluous newlines which might cause compilation problems in latex when used inside tables -}++tableContentToLaTeX2 ::+ [Anything Char] -> (StateT TableState (State MyState) String)+tableContentToLaTeX2 l+ = do r <- tableContentToLaTeX l+ return (killnl2 r)++varwidthbegin :: TableState -> [Char]+varwidthbegin st+ = if isJust (activeColumn st) then "\\begin{varwidth}{\\linewidth}"+ else ""++varwidthend :: TableState -> [Char]+varwidthend st+ = if isJust (activeColumn st) then "\\end{varwidth}" else ""++{-| This function renders the inner parts of a table to latex, please always use tableContentToLaTeX2 since this also removes superfluous newlines -}++tableContentToLaTeX ::+ [Anything Char] -> (StateT TableState (State MyState) String)+tableContentToLaTeX ((Environment TableRowSep _ _) : [])+ = do st <- get+ let cc = (currentColumn st)+ let c = cc + (multiRowCount cc (multiRowMap st))+ return $+ (varwidthend st) +++ (headendsym (lastCellWasHeaderCell st)) +++ (multiColumnEndSymbol (lastCellWasMultiColumn st)) +++ (rowaddsym st{currentColumn = c})+tableContentToLaTeX ((Environment TableRowSep _ l) : xs)+ = do sst <- lift get+ st <- get+ let cc = (currentColumn st)+ let c = cc + (multiRowCount cc (multiRowMap st))+ let mycond+ = (not (currentRowIsHeaderRow st)) &&+ (stillInTableHeader st) &&+ (lastRowHadEmptyMultiRowMap st) && (not (isFirstRow st))+ put+ (st{rowCounter = 1 + (rowCounter st),+ outputTableHasHeaderRows =+ (outputTableHasHeaderRows st) || (currentRowIsHeaderRow st),+ lastRowHadEmptyMultiRowMap = (myempty (multiRowMap st))})+ st2 <- get+ put+ st2{outputLastRowOfHeader =+ (if mycond then rowCounter st2 else outputLastRowOfHeader st2)}+ st3 <- get+ put+ st3{lastCellWasNotFirstCellOfRow = False,+ lastCellWasMultiColumn = False, currentColumn = 1,+ multiRowMap =+ multiRowDictChange (currentColumn st) (multiRowMap st) l,+ lastCellWasMultiRow = False, isFirstRow = False,+ lastCellWasHeaderCell = False, currentRowIsHeaderRow = False,+ stillInTableHeader =+ if stillInTableHeader st then not mycond else False}+ xx <- tableContentToLaTeX xs+ return $+ if (not (isFirstRow st)) then+ (varwidthend st) +++ (headendsym (lastCellWasHeaderCell st)) +++ (multiColumnEndSymbol (lastCellWasMultiColumn st)) +++ (multiRowEndSymbol (lastCellWasMultiRow st)) +++ (multiRowSymbolForRowSep (currentColumn st) (multiRowMap st)+ (seperatingLinesRequestedForTable st))+ +++ (rowaddsym st{currentColumn = c}) +++ (rowendsymb ((getInTab sst) <= 1)+ ((rowCounter st) == (inputLastRowOfHeader st) - 2))+ +++ (innerHorizontalLine (seperatingLinesRequestedForTable st)+ (multiRowMap st3)+ (numberOfColumnsInTable st))+ ++ " \n" ++ (varwidthbegin st) ++ xx+ else xx+tableContentToLaTeX ((Environment TableColSep _ l) : xs)+ = do st <- get+ let cc = (currentColumn st)+ let c = cc + (multiRowCount cc (multiRowMap st))+ put+ st{lastCellWasNotFirstCellOfRow = True,+ lastCellWasMultiColumn =+ ("" /=+ (multiColumnStartSymbol l (columnsWidthList st) c+ (seperatingLinesRequestedForTable st)+ st)),+ currentColumn = (c + (columnMultiplicityForCounting l)),+ multiRowMap =+ multiRowDictChange (currentColumn st) (multiRowMap st) l,+ lastCellWasMultiRow =+ (multiRowStartSymbol l (activeColumn st)) /= "",+ isFirstRow = False, lastCellWasHeaderCell = False}+ xx <- tableContentToLaTeX xxs+ return $+ (varwidthend st) +++ (headendsym (lastCellWasHeaderCell st)) +++ (multiColumnEndSymbol (lastCellWasMultiColumn st)) +++ (multiRowEndSymbol (lastCellWasMultiRow st)) +++ (columnSeperator (lastCellWasNotFirstCellOfRow st)) +++ (multiRowSymbol (currentColumn st) (multiRowMap st)+ (seperatingLinesRequestedForTable st))+ +++ (multiColumnStartSymbol l (columnsWidthList st) c+ (seperatingLinesRequestedForTable st)+ st)+ +++ (multiRowStartSymbol l (activeColumn st)) +++ (if rig then "\\RaggedLeft{}" else "") +++ (tablecolorsym l) ++ hypennothing ++ (varwidthbegin st) ++ xx+ where rig+ = isInfixOf2+ [Environment Attribute (Attr ("style", "text-align:right")) []]+ l+ xxs+ = if rig then (reverse . removesp . reverse . removesp) xs else xs+ removesp (C ' ' : as) = removesp as+ removesp a = a+tableContentToLaTeX ((Environment TableHeadColSep _ l) : xs)+ = do st <- get+ let cc = currentColumn st+ let c = cc + (multiRowCount cc (multiRowMap st))+ put+ st{lastCellWasNotFirstCellOfRow = True,+ lastCellWasMultiColumn =+ ("" /=+ (multiColumnStartSymbol l (columnsWidthList st) c+ (seperatingLinesRequestedForTable st)+ st)),+ currentColumn = (c + (columnMultiplicityForCounting l)),+ multiRowMap =+ multiRowDictChange (currentColumn st) (multiRowMap st) l,+ lastCellWasMultiRow =+ multiRowStartSymbol l (activeColumn st) /= "",+ isFirstRow = False, lastCellWasHeaderCell = True,+ currentRowIsHeaderRow = True}+ xx <- tableContentToLaTeX xs+ return $+ (varwidthend st) +++ (headendsym (lastCellWasHeaderCell st)) +++ (multiColumnEndSymbol (lastCellWasMultiColumn st)) +++ (multiRowEndSymbol (lastCellWasMultiRow st)) +++ (columnSeperator (lastCellWasNotFirstCellOfRow st)) +++ (multiRowSymbol (currentColumn st) (multiRowMap st)+ (seperatingLinesRequestedForTable st))+ +++ (multiColumnStartSymbol l (columnsWidthList st) c+ (seperatingLinesRequestedForTable st)+ st)+ +++ (multiRowStartSymbol l (activeColumn st)) +++ headstartsym +++ (tablecolorsym l) ++ hypennothing ++ (varwidthbegin st) ++ xx+tableContentToLaTeX (x : xs)+ = do st <- get+ ele <- case (activeColumn st) of+ Just n | (n /= fromIntegral (currentColumn st)) ||+ (lastCellWasMultiColumn st)+ -> return []+ _ -> lift $ treeToLaTeX2 [x]+ xx <- tableContentToLaTeX xs+ return $ ele ++ xx+tableContentToLaTeX []+ = do st <- get+ let cc = currentColumn st+ let c = cc + (multiRowCount cc (multiRowMap st))+ return $+ (varwidthend st) +++ (headendsym (lastCellWasHeaderCell st)) +++ (multiColumnEndSymbol (lastCellWasMultiColumn st)) +++ (multiRowSymbolForTableEnd (currentColumn st) (multiRowMap st)+ (seperatingLinesRequestedForTable st))+ +++ (multiRowEndSymbol (lastCellWasMultiRow st)) +++ (rowaddsym+ st{currentColumn = (c + (columnMultiplicityForCounting []))})++{-| This string has to be added to each new cell in a latex table in order to allow for hyphenation of the first word in this cell -}++hypennothing :: [Char]+hypennothing = "\\hspace*{0pt}\\ignorespaces{}\\hspace*{0pt}"++{-| color cell in latex if HTML attribute bgcolor is present in the parse tree for the cell -}++tablecolorsym :: [Anything Char] -> [Char]+tablecolorsym ll+ = case genLookup "bgcolor" ll of+ Just x -> case x of+ ('#' : ys) -> let (p, colname, col) = colinfo ('l' : 'l' : ys) in+ if p then "\\cellcolor[rgb]" ++ col else+ "\\cellcolor{" ++ colname ++ "}"+ _ -> "\\cellcolor{" ++ x ++ "}"+ Nothing -> ""++{-| the caption of a table is given in |+ or <th> elements, it needs to be reformatted in the parse in oder to be rendered in latex as a multicolumn cell spanning the whole width of the table -}++reformatTableCaption ::+ Int -> [Anything Char] -> MyState -> [Anything Char]+reformatTableCaption n+ ((Environment TableCap _ l) : ((Environment TableRowSep a b) : xs))+ st+ = if (filter (not . isSpace) (treeToLaTeX l st)) == [] then+ reformatTableCaption n xs st else+ (Environment TableRowSep (Str "") []) :+ ((Environment TableHeadColSep (Str "")+ [Environment Attribute (Attr ("colspan", (show n))) []])+ : l)+ ++ [(Environment TableRowSep a b)] ++ reformatTableCaption n xs st+reformatTableCaption n ((Environment TableCap _ l) : xs) st+ = if (filter (not . isSpace) (treeToLaTeX l st)) == [] then+ reformatTableCaption n xs st else+ (Environment TableRowSep (Str "") []) :+ ((Environment TableHeadColSep (Str "")+ [Environment Attribute (Attr ("colspan", (show n))) []])+ : l)+ +++ [(Environment TableRowSep (Str "") [])] +++ reformatTableCaption n xs st+reformatTableCaption n (x : xs) st+ = x : reformatTableCaption n xs st+reformatTableCaption _ [] _ = []++{-| strips column separators out of a parse tree or part of which -}++stripColSep :: [Anything Char] -> [Anything Char]+stripColSep = filter go+ where go (Environment TableHeadColSep _ _) = False+ go (Environment TableColSep _ _) = False+ go _ = True++{-| predicate to test if an element in the parse tree is a row separator -}++isRowSep :: Anything Char -> Bool+isRowSep (Environment TableRowSep _ _) = True+isRowSep _ = False++{-| strip empty rows out of the parse tree -}++stripempty :: [Anything Char] -> MyState -> [Anything Char]+stripempty [] _ = []+stripempty ((Environment TableRowSep a b) : xs) s+ = (Environment TableRowSep a b) : (stripempty xs s)+stripempty l s+ = if pred2 then (stripempty post2 s) else+ pre ++ (stripempty (post3 post) s)+ where post2+ = case post of+ (x : xs) -> if isRowSep x then xs else post+ [] -> post+ post3 o+ = case o of+ (x : (y : xs)) -> if (isRowSep x) && (isRowSep y) then+ post3 (y : xs) else (x : y : xs)+ x -> x+ pred2 = and (map (`elem` [' ', '\r', '\n']) inside)+ pre = takeWhile (not . isRowSep) l+ post = dropWhile (not . isRowSep) l+ inside = (treeToLaTeX (stripColSep pre)) s++{-| In order to determine the maximum width of columns, each table is precompiled with latex several times, with only one column included each time. this function creates the list of the latex sources of these tables, for one table in the parse tree -}++maketablist ::+ [Anything Char] -> TableState -> Int -> MyState -> [[Char]]+maketablist l tst nc mst = map tablo [1 .. (nc + 1)]+ where tablo n+ = "\\begin{tabular}{|" +++ (replicate nc 'l') +++ "|}" +++ "\\begin{varwidth}{\\linewidth}" +++ (fst+ (fst+ (runState+ ((runStateT (tableContentToLaTeX2 l))+ tst{inputLastRowOfHeader = -2, activeColumn = Just n})+ mst)))+ ++ "\\end{tabular}"++{-| Takes a map from int to double finds the biggest double and removes the corresponding key value pair from the map. This way wide columns are set to smaller sizes in order to fit the whole table onto the page width -}++removehighest :: Map Int Double -> Map Int Double+removehighest m+ | m /= Map.empty = Map.fromList (hlp (Map.toList m))+ where mx = maximum (Map.elems m)+ hlp ((_, v) : xs) | v == mx = xs+ hlp (x : xs) = x : (hlp xs)+ hlp [] = []+removehighest _ = Map.empty++{-| Returns a list of floats which represents the width of the columns of a table in units of the line width with the proper corrections for use in the a latex documents. If the boolean input parameter is true the table is understood to be written in landscape mode. It also take a map of Int to Double. This is the list of the maximum width of columns determined by previous runs of latex on the table with only one column included per run -}++wdth3 :: Bool -> Map Int Double -> ([Float], Double)+wdth3 ls m+ | m /= Map.empty =+ ((map+ ((* (1.0 - (scalefactor (fromIntegral n)))) .+ double2Float . (/ (linew2 ls)))+ (Map.elems mm)),+ if d == 1.0 then 1.0 else d * 0.9)+ where n = (maximum (Map.keys m))+ (mm, d) = wdth ls n m+wdth3 _ _ = ([], 1.0)++{-| Returns a table header which represents the width of the columns of a table in units of the line width with the proper corrections for use in the a latex documents. If the first boolean input parameter is true the table is understood to be written in landscape mode. It also take a map of Int to Double. This is the list of the maximum width of columns determined by previous runs of latex on the table with only one column included per run. If second boolean parameter is true it is understood the the rule should be printed with the table, otherwise the table should be printed without rules -}++wdth2 :: Bool -> Map Int Double -> Bool -> String+wdth2 ls m b+ | m /= Map.empty =+ tableSpecifier b+ (map+ ((* (1.0 - (scalefactor (fromIntegral n)))) .+ double2Float . (/ (linew2 ls)))+ (Map.elems mm))+ where n = (maximum (Map.keys m))+ (mm, _) = wdth ls n m+wdth2 _ _ _ = []++{-| takes the list of maximum column widths created by previous runs of the latex compiler with only one columns included per run as map from Int to Double. Take the total number of columns of the table as Int. The table is understood to be printed in landscape mode if the boolean parameter is true. It returns a map from int to double representing the width of columns of the table to be used in the latex documents. So it takes raw widths. Which are just the width of the column if the width of the paper was infinite and return the width that fit on the finite width of the real paper -}++wdth :: Bool -> Int -> Map Int Double -> (Map Int Double, Double)+wdth ls n mm+ = case+ (Control.Monad.msum+ (map hlp+ (zip+ (iterate removehighest+ (Map.mapMaybe+ (\ x -> Just $ x / (1.0 - (scalefactor (fromIntegral n))))+ mm))+ [0 .. (length (Map.keys mm))])))+ of+ Just (x, Nothing) -> if (sum (Map.elems x)) < (linew2 ls) then+ (Map.map (\ y -> y * ((linew2 ls) / (sum (Map.elems x)))) x, 1.0)+ else (x, 1.0)+ Just (x, Just ddd) -> (Map.map+ (\ y -> y * ((linew2 ls) / (sum (Map.elems x))))+ x,+ ddd)+ Nothing -> (myfill ((linew2 ls) / (fromIntegral n)) Map.empty, 1.0)+ where hlp ::+ (Map Int Double, Int) -> Maybe ((Map Int Double), Maybe Double)+ hlp (m, i)+ | ((sum (Map.elems m)) :: Double) ++ ((linew2 ls) / (fromIntegral n)) * (fromIntegral i)+ < (linew2 ls)+ =+ Just+ (myfill+ (((linew2 ls) - (sum (Map.elems m))) /+ ((fromIntegral i) :: Double))+ m,+ Nothing)+ hlp (_, i)+ | ((i == 3) || (i == n)) =+ let (mmm, dd) = (wdth ls n (Map.map ((\ x -> x * 0.95)) mm)) in+ Just (mmm, Just ((0.965) * dd))+ hlp (m, i)+ | ((sum (Map.elems m)) :: Double) ++ ((linew2 ls) / (fromIntegral n)) * (fromIntegral i)+ >= (linew2 ls)+ = Nothing+ hlp _+ = Just (myfill ((linew2 ls) / (fromIntegral n)) Map.empty, Nothing)+ + myfill :: Double -> Map Int Double -> Map Int Double+ myfill x m = Map.union m (Map.fromList (zip [1 .. n] (repeat x)))++{-| In landscape mode everything has to be multiplied by a factor of two. If the boolean parameter is true it is understood that the table should be printed in landscape mode. This function return the width of the line in latex using the units of latex -}++linew2 :: Bool -> Double+linew2 ls = if ls then linew * 1.414 else linew++{-| The width of the line in A4 paper with DIV margin factor of 13 in latex own units -}++linew :: Double+linew = 455.45742++hasTable :: [Anything a] -> Bool+hasTable ll = or $ map go ll+ where go :: Anything a -> Bool+ go (Environment Wikitable _ _) = True+ go (Environment _ _ l) = (hasTable l)+ go _ = False++{-| convert a table form the parse tree to latex. The [Anything Char] parameter it the contend of the table represented as a parse tree. The String parameter contains the HTML attributes of the table element, or in wiki notation the HTML parameters of the line beginning with {| . This is evaluated in order to find out whether rules should be printed in the table. The return type is Renderer String. Which means that it returns a string but also take a state as additional monadic input parameter and returns a possible changed version of it as additional return parameter monadically -}++tableToLaTeX :: [Anything Char] -> String -> Renderer String+tableToLaTeX l1 s+ = do st <- get+ let modst = st{getF = (getF st) * (tableScale (numberOfColumns l))}+ ((_, oldstate), _)+ = runState ((runStateT (tableContentToLaTeX2 reformed)) tblstate)+ modst+ ((t1, _), newstate)+ = runState+ ((runStateT (tableContentToLaTeX2 reformed))+ tblstate{inputLastRowOfHeader =+ if outputTableHasHeaderRows oldstate then+ outputLastRowOfHeader oldstate else -2})+ modst{tablist =+ (maketablist reformed tblstate (numberOfColumns l) modst) :+ (tablist st)}+ reformed = ((reformatTableCaption (numberOfColumns l) l st))+ l = stripempty l1 st+ spec+ = case Map.lookup tbno (tabmap st) of+ Nothing -> (if (tableSpecifier sep widths) == "" then+ "p{\\linewidth}" else tableSpecifier sep widths)+ Just t -> wdth2 lsc t sep+ sep = seperatingLinesRequested s+ hline = horizontalLine sep+ (widths, fontscalefactor)+ = case Map.lookup tbno (tabmap st) of+ Nothing -> (columnWidths l, 1.0)+ Just t -> wdth3 lsc t+ env = tableEnvironment (getF st)+ scriptsize+ = (isInfixOf2 "latexfontsize=\"scriptsize\"" s) ||+ ((numberOfColumns l) > 5)+ sb = if scriptsize then "{\\scriptsize{}" else ""+ se = if scriptsize then "}" else ""+ lsc+ = (env == "longtable") &&+ (((numberOfColumns l) > 100) || (hasTable l1))+ lsb = if lsc then "\\begin{landscape}\n" else ""+ lse = if lsc then "\n\\end{landscape}" else ""+ tbno = (length (tablist st)) + 1+ tblstate+ = TableState{seperatingLinesRequestedForTable = sep,+ lastCellWasNotFirstCellOfRow = False,+ lastCellWasMultiColumn = False, columnsWidthList = widths,+ currentColumn = 1, multiRowMap = Map.empty,+ lastCellWasMultiRow = False,+ numberOfColumnsInTable = (numberOfColumns l), isFirstRow = True,+ lastCellWasHeaderCell = False, currentRowIsHeaderRow = False,+ stillInTableHeader = True, rowCounter = 0,+ outputLastRowOfHeader = 0, inputLastRowOfHeader = 0,+ lastRowHadEmptyMultiRowMap = True,+ outputTableHasHeaderRows = False, activeColumn = Nothing}+ put $ newstate{getF = getF st}+ r <- return $+ lsb +++ sb +++ (if (env /= "tabular") then "\n" else "\\scalebox{0.85}{") +++ (if fontscalefactor == 1.0 then "" else+ "{\\scalefont{" ++ (printf "%0.5f" fontscalefactor) ++ "}")+ +++ "\\begin{" +++ env +++ "}{" +++ spec +++ "}" +++ hline +++ " \n" +++ t1 +++ (rowDelimiter sep) +++ " \n\\end{" +++ env +++ "}\n" +++ (if fontscalefactor == 1.0 then "" else "}") +++ (if (env /= "tabular") then "" else "}") +++ se ++ lse+ return r++{-| Converts an image from the parse tree to latex. The actual images is only referenced in the wiki source, as well as the parse tree, as well as the latex source. It takes a parse tree representation of the image as only input parameter. The return type is Renderer String. Which means that it returns a string but also take a state as additional monadic input parameter and returns a possible changed version of it as additional return parameter monadically -}++wikiImageToLaTeX :: [Anything Char] -> Renderer String+wikiImageToLaTeX l+ = do st <- get+ mystr <- return $+ (if not (micro st) then+ "\n" +++ (if ((getInTab st) == 0) then "\n" else "") +++ "\\begin{minipage}{" +++ (if (msb st) then "1.0" else (mysize st)) +++ (if (msb st) then "\\linewidth" else "\\textwidth") ++ "}\n"+ else (if ((getInTab st) == 0) then "\n" else ""))+ +++ (if (not (micro st)) then "\\begin{center}\n" else "") +++ "\\includegraphics[width=" +++ (if (not (micro st)) then "1.0" else (mysize st)) +++ (if (msb st) then "\\linewidth" else "\\textwidth") +++ ",height=6.5in,keepaspectratio]{../images/" +++ (n st) +++ "." +++ ext +++ "}\n" +++ (if (not (micro st)) then "\\end{center}\n" else "") +++ (if (not (tb st)) && (not (micro st)) then "\\raggedright{}"+ else "")+ +++ (if not (micro st) then+ (if (s st) == "" then+ "\\myfigurewithoutcaption{" ++ (n st) ++ "}" else+ "\\myfigurewithcaption{" +++ (n st) ++ "}{" ++ (s st) ++ "}")+ else "")+ +++ (if not (micro st) then "\n\\end{minipage}" else "") +++ (addit st) +++ (if not (micro st) then+ (if ((getInTab st) == 0) then "\n" else "") +++ "\n"+ else " ")+ put+ st{getImages = (getImages st) ++ [shallowFlatten l],+ getJ = ((getJ st) + 1)}+ return mystr+ where ext+ = normalizeExtension+ (map toLower+ (fileNameToExtension (headSplitEq '|' (shallowFlatten l))))+ s st+ = if (trim (s1 st)) `elem` ["verweis=", "alt=", "link="] then ""+ else (s1 st)+ s2 st+ = case Map.lookup "alt" (snd (prepateTemplate l "x")) of+ Just xx -> wikiLinkCaption xx st+ Nothing -> wikiLinkCaption l st+ s1 st+ = if '|' `elem` (shallowFlatten l) then (s2 st) else+ (treeToLaTeX [] st{getJ = ((getJ st) + 1)})+ mysize st = printf "%0.5f" (mysizefloat2 st)+ mysizefloat st = (min (getF st) (imageSize l))+ mysizefloat2 st = if (msb st) then 1.0 else (mysizefloat st)+ msb st = (mysizefloat st) == (getF st)+ micro st = ((mysizefloat st) < 0.17) || ((getInTab st) > 1)+ n st = show (getJ st)+ tb st = ((getInTab st) > 0)+ addit st+ = if (getInTab st) > 0 then "" else+ (if not (micro st) then "\\vspace{0.75cm}" else "")++{-| Returns the caption of a wikilink. Takes a parse tree representation of the wikilink and the current state of the renderer. Return the caption in LaTeX representation as string. A Wikilink is represented as [[FooBar]] in Wiki notation. -}++wikiLinkCaption :: [Anything Char] -> MyState -> String+wikiLinkCaption l st = if isCaption x then rebuild x else ""+ where x = (treeToLaTeX (last (splitOn [C '|'] l)) st)+ rebuild (':' : xs) = xs+ rebuild b = b++{-| Returns the LaTeX representation of a wikilink. Takes a parse tree representation of the wikilink and the current state of the render. A Wikilink is represented as [[FooBar]] in Wiki notation. -}++wikiLinkToLaTeX :: [Anything Char] -> MyState -> String+wikiLinkToLaTeX l st+ = case+ Map.lookup (map toUpper (finalloc st))+ (Map.mapKeys (map toUpper) (urls st))+ of+ Just yy -> "\\my" +++ addit ++ "lref{" ++ yy ++ "}{" ++ (wikiLinkCaption l st) ++ "}"+ Nothing -> case+ do hh <- maybeHead . (splitOn "#") . (map toUpper) $ (finalloc st)+ Map.lookup (Just hh)+ (Map.mapKeys (maybeHead . (splitOn "#") . (map toUpper)) (urls st))+ of+ Just yy -> "\\my" +++ addit ++ "lref{" ++ yy ++ "}{" ++ (wikiLinkCaption l st) ++ "}"+ Nothing -> "\\my" +++ addit +++ "href{" +++ (wikiLinkLocationesc l st) +++ "}{" ++ (killnl (wikiLinkCaption l st)) ++ "}"+ where zzz sssst+ = case localWikiLinkLocation (loc) of+ ('#' : xs) -> (currentUrl sssst) ++ ('#' : xs)+ xs -> xs+ finalloc3 sts = replace2 (trim (zzz sts)) " " "_"+ finalloc ssst+ = case reverse (finalloc3 ssst) of+ ('/' : xs) -> reverse xs+ _ -> finalloc3 ssst+ restpath+ = intercalate "/"+ (reverse (drop len (reverse (splitOn "/" (currentUrl st)))))+ loc = if len > 0 then restpath ++ "/" ++ rest else rest+ (len, rest) = doit2 0 (shallowFlatten l)+ doit2 n ('.' : ('.' : ('/' : xs))) = doit2 (n + 1) xs+ doit2 n xs = (n, xs)+ addit+ = if getInFootnote st then "fn" else+ if ((getInTab st) > 1) then "tab" else ""+ killnl ('\n' : ('\n' : xs)) = killnl ('\n' : xs)+ killnl (x : xs) = x : (killnl xs)+ killnl [] = []++{-| If repeated newlines appear in a string directly after each other. Each series of newlines is reduced to exactly one newline -}++killnl2 :: String -> String+killnl2 ('\n' : ('\n' : xs)) = killnl2 ('\n' : xs)+killnl2 ('\n' : xs)+ = if (trim pre) == "" then killnl2 post else pre ++ (killnl2 post)+ where pre = (takeWhile (/= '\n') xs)+ post = (dropWhile (/= '\n') xs)+killnl2 (x : xs) = x : (killnl2 xs)+killnl2 [] = []++{-| returns the caption of a link. A link is represented as [foobar.com mycaption] in wiki notation. It takes the parse tree representation of the link as first input parameter. The second input parameter is the current state of the renderer. The third parameter is the Uri scheme as string (See 'URI scheme' in the English wikipeda) usually this is 'http'. It returns the latex representation of the caption of the link as string -}++linkCaption ::+ [Anything Char] -> MyState -> String -> Bool -> String+linkCaption l st s b+ = case spl of+ (_ : (gg : gs)) -> (treeToLaTeX+ (concat (gg : (map (\ x -> (C ' ') : x) gs)))+ st)+ _ -> if b then "" else s ++ (escapelink (linkLocation l))+ where spl = splitOn [C ' '] l++{-| returns the latex representation of a link. A link is represented as [foobar.com mycaption] in wiki notation. It takes the parse tree representation of the link as first input parameter. The second input parameter is the current state of the renderer. The third parameter is the Uri scheme as string (See 'URI scheme' in the English wikipeda) usually this is 'http'. It returns the latex representation of the link as string -}++linkToLaTeX :: [Anything Char] -> MyState -> String -> String+linkToLaTeX l st s+ = if+ (b && cap == "") || (cap == (s ++ (escapelink (linkLocation l))))+ then "\\myplainurl{" ++ s ++ (escapelink (linkLocation l)) ++ "}"+ else+ "\\my" +++ addit +++ "href{" ++ s ++ (escapelink (linkLocation l)) ++ "}{" ++ cap ++ "}"+ where addit = if b then "fn" else ""+ b = getInFootnote st+ cap = (linkCaption l st s b)++{-| takes a list and splits it into sublist of equal length, allowing a possible smaller length for the last list in case the devision does not create an integer result. -}++splitToTuples :: [a] -> [[a]]+splitToTuples x+ = map (take galleryNumberOfColumns) .+ takeWhile (not . null) . iterate (drop galleryNumberOfColumns)+ $ x++{-| the number of column to be used in latex documents for mediawikis gallery (image gallery) (gallery tags) -}++galleryNumberOfColumns :: Int+galleryNumberOfColumns = 1++{-| the width of a column for the table of the latex version of mediawikis gallery (image gallery, gallery tags) -}++galleryTableScale :: Float+galleryTableScale+ = (1.0 / (fromIntegral galleryNumberOfColumns)) - (scalefactor 1.0)++{-| the latex string for a single column in table header in the latex version of mediawikis gallery (image gallery, gallery tag) -}++galleryTableSpecifier :: String+galleryTableSpecifier+ = concat $+ replicate galleryNumberOfColumns+ ">{\\RaggedRight}p{0.5\\linewidth}"++{-| converts the inner parts gallery (image gallery, gallery tag) from parse tree notation to latex, does not write the latex table header and footer. This is only a helper function. Always use galleryToLatex if you want to convert a gallery to latex -}++galleryContentToLatex :: [[Anything Char]] -> Renderer String+galleryContentToLatex (x : xs)+ = do s <- galleryRowToLaTex x+ ss <- galleryContentToLatex xs+ return $ s ++ "\\\\ \n" ++ ss+galleryContentToLatex [] = return []++{-| converts a part of a gallery (image gallery, gallery tag) from parse tree to latex. A part are as many elements as fit into a single row in the resulting latex table -}++galleryRowToLaTex :: [Anything Char] -> Renderer String+galleryRowToLaTex [] = return []+galleryRowToLaTex (x : []) = treeToLaTeX2 [x]+galleryRowToLaTex (x : xs)+ = do s <- treeToLaTeX2 [x]+ g <- galleryRowToLaTex xs+ return $ s ++ "&" ++ g++{-| Converts are gallery (image gallery, gallery tag) from parse tree to latex. Also writes table header and footer. This is the function you should use for converting galleries to latex -}++galleryToLatex :: [Anything Char] -> Renderer String+galleryToLatex x+ = do st <- get+ put st{getF = (getF st) * galleryTableScale}+ s <- (galleryContentToLatex+ [z | z <- splitToTuples [y | y <- x, isWikiLink y],+ trim (treeToLaTeX z st) /= ""])+ st2 <- get+ put st2{getF = (getF st)}+ return+ ("\\begin{longtable}{" +++ galleryTableSpecifier ++ "} \n" ++ s ++ "\\end{longtable}")++{-| A function to drop all unnecessary elements of an HTML image map, so that it can be converted to latex by calling treeToLaTeX2 -}++imageMapClean :: [Anything Char] -> [Anything Char]+imageMapClean ((Environment Wikilink s l) : xs)+ = (Environment Wikilink s l) : imageMapClean xs+imageMapClean (_ : xs) = imageMapClean xs+imageMapClean [] = []++{-| Takes the parse tree representation of an image, and returns the its size in unit of the width of a line in latex. Images 400px or wider in wiki notation are understood to use the full width of the line. Smaller one are considered fractionally. That means 100px means 0.25 the width of the line and 200px means 0.5 width of the line -}++imageSize :: [Anything Char] -> Float+imageSize l = if [] == x then 1.0 else (minimum x)+ where x = map readImageSize (imageSizeStrings (shallowFlatten l))++{-| takes a candidate string for the width of an image in the wikis px notation. Returns 1.0 if the candidate could not be parsed, returns the width of the image in units of the width of a line in latex otherwise. Images 400px or wider in wiki notation are understood to use the full width of the line. Smaller one are considered fractionally. That means 100px means 0.25 the width of the line and 200px means 0.5 width of the line -}++readImageSize :: String -> Float+readImageSize y+ = case (reads x) of+ [] -> 1.0+ (h : _) -> fst h / 400.0+ where x = removex y+ removex ('x' : zs) = zs+ removex z = z++{-| takes a flattend version of a parse tree represendtation of an image and retruns a list of substrings which are candidates for representing the width of the image in the wikis px notation -}++imageSizeStrings :: String -> [String]+imageSizeStrings s+ = [take (length (x) - 2) (x) |+ x <- ((splitOn ['|'] s) :: [String]), isSuffixOf "px" x]++{-| converts a mathematical fomula from the wiki to latex notation -}++mathToLatex :: [Anything Char] -> String+mathToLatex l+ = if isInfixOf2 "\\begin{alignat}" (shallowFlatten l) then+ mathTransform l else "{$" ++ (mathTransform l) ++ "$}"++{-| a predicate that returns true if and only if the input is a parse tree that contains only spaces but no other structures -}++onlySpaces :: [Anything Char] -> Bool+onlySpaces ((C ' ') : xs) = onlySpaces xs+onlySpaces [] = True+onlySpaces _ = False++{-| in the wiki notation pipe (|)inside temples are escaped as {!} and double pipes as {!!}}. this function undoes this escaping in a parse tree -}++prepateParameter :: [Anything Char] -> [Anything Char]+prepateParameter ((Environment Template _ [C '!']) : xs)+ = (C '|') : prepateParameter xs+prepateParameter ((Environment Template _ [C '!', C '!']) : xs)+ = (C '|') : (C '|') : prepateParameter xs+prepateParameter (x : xs) = x : prepateParameter xs+prepateParameter [] = []++{-| this function prepares a template as parse by the parser in the parse tree notation into a other notation that can be further processes by the latex renderer and the function templateToLatex in particular. The first input parameter is the parse tree notation of the template. The second is the name of the template as string. It returns a tuple, the first element of this tuple is the name of the template (stripped of heading an tailing white space) and the second element of the tuple is a map from strings to parse trees. The strings are the names of the parameters of the template. These might be just numbers represented as string but also any other strings -}++prepateTemplate ::+ [Anything Char] -> String -> (String, Map String [Anything Char])+prepateTemplate ll x = (trim x, enum ll 1 (Map.fromList []))+ where enum ::+ [Anything Char] ->+ Integer -> Map String [Anything Char] -> Map String [Anything Char]+ enum ((Environment TemplateInside (Str "") l) : zs) i d+ = enum zs (i + 1) (Map.insert (show i) (prepateParameter l) d)+ enum ((Environment TemplateInside (Str z) l) : zs) i d+ = enum zs i (Map.insert (trim z) (prepateParameter l) d)+ enum [] _ d = d+ enum (_ : zs) i d = enum zs i d++{-| converts a template from the wiki to latex. The first parameter is the parse tree representation of the template as generated by the parse the second is the name of the template. It returns a Renderer String. That is it returns the latex representation of the template, but also takes a state as an additional monadic input parameter and returns a possible changed version of it as additional return parameter monadically -}++templateToLatex :: [Anything Char] -> String -> Renderer String+templateToLatex l s+ = state $+ \ st ->+ case l of+ ((C 'w') : ((C '|') : xs)) -> (wikiLinkToLaTeX+ ((C 'w') : (C ':') : xs)+ st,+ st)+ ((C 'W') : ((C '|') : xs)) -> (wikiLinkToLaTeX+ ((C 'w') : (C ':') : xs)+ st,+ st)+ ((C 'B') : ((C '|') : xs)) -> (wikiLinkToLaTeX xs st, st)+ _ -> swap $ templateProcessor st (prepateTemplate l s)++mnfindentlatex :: Map String [Anything Char] -> Renderer String+mnfindentlatex ll+ = do one <- treeToLaTeX2 (Map.findWithDefault [] "1" ll)+ st <- get+ return+ ("\n\\begin{" +++ (itemEnvironmentName ":" (getF st)) +++ "}" +++ (itemEnvironmentParameters ":" (getF st)) +++ "\n\\item{}" +++ one ++ "\n\\end{" ++ (itemEnvironmentName ":" (getF st)) ++ "}\n")++{-| function to converts wikipedias citearticle template to latex -}++citearticle :: Map String [Anything Char] -> Renderer String+citearticle ll+ = state $+ \ st ->+ ((treeToLaTeX (Map.findWithDefault [] "author" ll) st) +++ (treeToLaTeX (Map.findWithDefault [] "first" ll) st) +++ (if Map.member "first" ll then " " else "") +++ (treeToLaTeX (Map.findWithDefault [] "last" ll) st) +++ ". " +++ (treeToLaTeX (Map.findWithDefault [] "title" ll) st) +++ (if Map.member "url" ll then+ "\\my" +++ (if getInFootnote st then "fn" else "") +++ "href{" +++ (treeToLaTeX (deepFlatten (Map.findWithDefault [] "url" ll)) st) +++ "}{" ++ (treeToLaTeX (Map.findWithDefault [] "title" ll) st) ++ "}"+ else (treeToLaTeX (Map.findWithDefault [] "title" ll) st))+ +++ ". " +++ "\\textit{{}" +++ (treeToLaTeX (Map.findWithDefault [] "journal" ll) st) +++ "}, " +++ (if Map.member "volume" ll then+ "{{\\bfseries " +++ (treeToLaTeX (Map.findWithDefault [] "volume" ll) st) ++ "}}"+ else "")+ +++ (if Map.member "publisher" ll then+ "(" +++ (treeToLaTeX (Map.findWithDefault [] "publisher" ll) st) +++ ")"+ else "")+ +++ (if Map.member "number" ll then+ "(" +++ (treeToLaTeX (Map.findWithDefault [] "number" ll) st) ++ ")"+ else "")+ +++ (if Map.member "pages" ll then+ ":" ++ (treeToLaTeX (Map.findWithDefault [] "pages" ll) st)+ else "")+ +++ (if Map.member "month" ll then+ (treeToLaTeX (Map.findWithDefault [] "month" ll) st) else+ "")+ +++ (treeToLaTeX (Map.findWithDefault [] "year" ll) st) +++ (if Map.member "url" ll then+ (treeToLaTeX (Map.findWithDefault [] "url" ll) st)+ else "")+ ++ "\n",+ st)++{-| removes source structures from a parse tree, keeping the source inside the source structure in the parse tree, so flattens out the source structure. You need this if some parse tree contains source code but you don't know whether or not it is inside a source tag -}++flattensource :: [Anything Char] -> [Anything Char]+flattensource ((Environment Source (TagAttr _ _) l) : xs)+ = l ++ (flattensource xs)+flattensource (x : xs) = x : (flattensource xs)+flattensource [] = []++{-| prepare code for printing in latex. takes the current state of the renderer as first parameter. takes the map version of the template containing the code as second parameter. returns the latex representation as string -}++trilex :: MyState -> Map String [Anything Char] -> String+trilex st ll = trilexgen st ll "code"++{-| prepare code for printing in latex. Takes the map version of the template containing the code as first parameter. returns the latex representation as string. It returns a Render String so that it can access the current state of the renderer as additional monadic input parameter -}++trilex2 :: Map String [Anything Char] -> Renderer String+trilex2 ll+ = do st <- get+ return $ trilexgen st ll "code"++{-| prepare code for printing in latex. takes the current state of the renderer as first parameter. takes the map version of the template containing the code as second parameter. takes the name of the parameter containing the actual source in the map as third parameter. returns the latex representation as string -}++trilexgen ::+ MyState -> Map String [Anything Char] -> String -> String+trilexgen st ll code+ = if Map.member code ll then+ (treeToLaTeX+ (breakLines3 73+ (killnewline (flattensource (Map.findWithDefault [] code ll))))+ st)+ else ""+ where killnewline :: [Anything Char] -> [Anything Char]+ killnewline ((C '\n') : xs) = killnewline xs+ killnewline x = x++{-| analyzes a color in HTML notation. It returns a triple. The first element is a boolean. If it is true the color has got rgb hex notation and the third parameter contains the rgb latex notation. If it is false, the color is not rgb and hopefully a HTML color name, which is returned a second element of the tuple -}++colinfo :: String -> (Bool, String, String)+colinfo colcode+ = case col of+ Just colo -> (True, map toLower colname, colo)+ Nothing -> (False, map toLower colname,+ case colnamehelper of+ Just x -> x+ Nothing -> colcode)+ where col = (makecol colnamehelper)+ colnamehelper+ = case colcode of+ (_ : (_ : gs)) -> Just gs+ _ -> Nothing+ colname+ = case+ do n <- colnamehelper+ guard $ mypred n+ return ("rgb" ++ n)+ of+ Just x -> x+ Nothing -> colcode+ + ss :: String -> [Integer]+ ss (a : (b : xs)) = (maybeToList . unhex $ [a, b]) ++ (ss xs)+ ss _ = []+ + ss3 :: String -> [Integer]+ ss3 (a : xs) = (maybeToList . unhex $ [a, a]) ++ (ss3 xs)+ ss3 _ = []+ + ss2 :: [Integer] -> [Float]+ ss2 (x : xs) = ((fromInteger x) / 255.0) : ss2 xs+ ss2 [] = []+ ss4 x = if (((length . ss) x) == 3) then ss x else ss3 x+ + prettyp2 :: [String] -> String+ prettyp2 (x : []) = x+ prettyp2 (x : xs) = x ++ "," ++ (prettyp2 xs)+ prettyp2 [] = []+ + prettyp :: [String] -> String+ prettyp x = "{" ++ (prettyp2 x) ++ "}"+ + makecol :: Maybe String -> Maybe String+ makecol x+ = do xx <- x+ guard $ mypred xx+ return $+ prettyp ((map (printf "%0.5f") ((ss2 . ss4) xx)) :: [String])+ mypred x = (((length . ss) x) == 3) || (((length . ss3) x) == 3)++{-| and adapter to convert between the monadic and non monadic version of render. A function returning renderer string means that it returns a string but takes a state as additional monadic input parameter and returns the a possibly modified version of it as an additional monadic output parameter. This function takes a monadic return value. That is renderer String and returns its non monadic version. -}++tempProcAdapter ::+ Renderer String -> (MyState -> (MyState, String))+tempProcAdapter = (swap .) . runState++{-| function for key strokes templates in the blender wikibook -}++key :: [Char] -> [Char]+key "AKEY" = "A"+key "BKEY" = "B"+key "CKEY" = "C"+key "DKEY" = "D"+key "EKEY" = "E"+key "FKEY" = "F"+key "GKEY" = "G"+key "HKEY" = "H"+key "IKEY" = "I"+key "JKEY" = "J"+key "KKEY" = "K"+key "LKEY" = "L"+key "MKEY" = "M"+key "NKEY" = "N"+key "OKEY" = "O"+key "PKEY" = "P"+key "QKEY" = "Q"+key "RKEY" = "R"+key "SKEY" = "S"+key "TKEY" = "T"+key "UKEY" = "U"+key "VKEY" = "V"+key "WKEY" = "W"+key "XKEY" = "X"+key "YKEY" = "Y"+key "ZKEY" = "Z"+key "-KEY" = "-{}"+key "SEMICOLON" = ";"+key "NUM-" = "NUM-{}"+key x = x++{-| converts a template to latex. Takes the current state of the render as first input parameter. The second input parameter is a tuple. Its first element is the name of the template as string. Its second element is a map, mapping the names of the parameters of the template to their parse tree representations, it returns a tuple. The First element is the possible change state of the renderer the second one is the latex representation of the template -}++templateProcessor ::+ MyState ->+ (String, Map String [Anything Char]) -> (MyState, String)+templateProcessor st ("main", ll)+ = (st,+ "Main Page: " +++ (wikiLinkToLaTeX (Map.findWithDefault [] "1" ll) st))+templateProcessor st ("#invoke:Mathe f\252r Nicht-Freaks/Seite", _)+ = (st, "")+templateProcessor st ("#invoke:Liste", _) = (st, "")+templateProcessor st ("!", _) = (st, "|")+templateProcessor st ("!!", _) = (st, "||")+templateProcessor st+ ("Mathe f\252r Nicht-Freaks: Vorlage:Frage", ll) = (st2, r)+ where j1 x = (Map.findWithDefault [] x ll)+ (r, st2)+ = runState+ (do a <- treeToLaTeX2 (j1 "typ")+ b <- treeToLaTeX2 (j1 "frage")+ c <- treeToLaTeX2 (j1 "antwort")+ return $+ if Map.member "typ" ll then+ "\\NFFrage{" ++ a ++ "}{" ++ b ++ "}{" ++ c ++ "}" else+ "\\NFFrageB{" ++ b ++ "}{" ++ c ++ "}")+ st+templateProcessor st ("Aufgabensammlung: Vorlage:Frage", ll)+ = (st2, r)+ where j1 x = (Map.findWithDefault [] x ll)+ (r, st2)+ = runState+ (do a <- treeToLaTeX2 (j1 "typ")+ b <- treeToLaTeX2 (j1 "frage")+ c <- treeToLaTeX2 (j1 "antwort")+ return $+ if Map.member "typ" ll then+ "\\NFFrage{" ++ a ++ "}{" ++ b ++ "}{" ++ c ++ "}" else+ "\\NFFrageB{" ++ b ++ "}{" ++ c ++ "}")+ st+templateProcessor st+ ("Mathe f\252r Nicht-Freaks: Vorlage:Mind Map", ll)+ = (st2,+ "\\section*{Mind Map}\\begin{landscape}" +++ r ++ "\\end{landscape}")+ where (r, st2)+ = runState+ (wikiImageToLaTeX+ ((C 'F') :+ (C 'i') :+ (C 'l') : (C 'e') : (C ':') : (Map.findWithDefault [] "1" ll)))+ st+templateProcessor st+ ("C++-Programmierung/ Vorlage:Buchinterner Link", ll)+ = (st,+ wikiLinkToLaTeX+ (if+ ("" /=+ (if length (splitOn "/" (currentUrl st)) > 2 then+ (id ((splitOn "/" (currentUrl st)) !! 2)) else []))+ then+ if Map.member "\220berschrift" ll then+ (map (C) "C++-Programmierung/ ") +++ (Map.findWithDefault [] "Abschnitt" ll) +++ [C '/', C ' '] +++ (Map.findWithDefault [] "Kapitel" ll) +++ [C '#'] +++ (Map.findWithDefault [] "\220berschrift" ll) +++ (if Map.member "Kapitelzusatz" ll then+ ((C) '_') : (Map.findWithDefault [] "Kapitelzusatz" ll) else [])+ else+ (if Map.member "Kapitel" ll then+ (map (C) "C++-Programmierung/ ") +++ (Map.findWithDefault [] "Abschnitt" ll) +++ [C '/', C ' '] ++ (Map.findWithDefault [] "Kapitel" ll)+ else+ (map (C) "C++-Programmierung/ Inhaltsverzeichnis#Anker:") +++ (Map.findWithDefault [] "Abschnitt" ll))+ +++ [C '|'] +++ (Map.findWithDefault+ (Map.findWithDefault+ (Map.findWithDefault (Map.findWithDefault [] "Abschnitt" ll)+ "Kapitel"+ ll)+ "\220berschrift"+ ll)+ "Text"+ ll)+ else+ if Map.member "\220berschrift" ll then+ (map (C) "C++-Programmierung/ ") +++ (Map.findWithDefault [] "Abschnitt" ll) +++ [C '#'] +++ (Map.findWithDefault [] "\220berschrift" ll) +++ (if Map.member "Abschnittszusatz" ll then+ ((C) '_') : (Map.findWithDefault [] "Abschnittszusatz" ll) else [])+ else+ (if Map.member "Kapitel" ll then+ (map (C) "C++-Programmierung/ ") +++ (Map.findWithDefault [] "Abschnitt" ll) +++ [C '#'] ++ (Map.findWithDefault [] "Kapitel" ll)+ else+ (map (C) "C++-Programmierung/ ") +++ (Map.findWithDefault [] "Abschnitt" ll))+ +++ [C '|'] +++ (Map.findWithDefault+ (Map.findWithDefault+ (Map.findWithDefault (Map.findWithDefault [] "Abschnitt" ll)+ "Kapitel"+ ll)+ "\220berschrift"+ ll)+ "Text"+ ll))+ st)+templateProcessor st ("B3D:N2P/Do", ll)+ = (st,+ intercalate "+"+ (filter (/= "\\keystroke{}")+ (map+ (\ x ->+ "\\keystroke{" +++ (key . (map toUpper))+ (treeToLaTeX (Map.findWithDefault [] (show x) ll) st)+ ++ "}")+ ([1, 2, 3, 4] :: [Integer]))))+templateProcessor st ("HaskellGHCiExample", ll)+ = (st,+ ("\\LaTeXDoubleBoxTemplate{Example:}{" +++ (treeToLaTeX (Map.findWithDefault [] "1" ll) st) +++ "\\newline " ++ trilexgen st ll "2" ++ "}\n"))+templateProcessor st ("Latex Index", ll)+ = (st,+ ("\\index{" +++ (concatMap go (deepFlatten (Map.findWithDefault [] "1" ll))) +++ "}"))+ where go (C x) = [x]+ go _ = []+templateProcessor st ("Komplexe Zahlen/ Vorlage:Formel", ll)+ = (st,+ (treeToLaTeX (shallowEnlargeMath (Map.findWithDefault [] "1" ll))+ st))+templateProcessor st ("Ada/95/RM", ll)+ = (st,+ (linkToLaTeX+ ((map C+ "http://www.adaic.org/resources/add_content/standards/95lrm/ARM_HTML/RM-")+ +++ one +++ (if has then [C '-'] else []) +++ two +++ (map C ".html") +++ [C ' '] +++ (if has then one ++ [C '.'] ++ two else+ (map C "Annex ") ++ one ++ [C ':'])+ ++ [C ' '] ++ (Map.findWithDefault [] "title" ll))+ st+ ""))+ where one = (Map.findWithDefault [] "1" ll)+ two = (Map.findWithDefault [] "2" ll)+ has = Map.member "2" ll+templateProcessor st ("Ada/2005/RM", ll)+ = (st,+ (linkToLaTeX+ ((map C+ "http://www.adaic.org/resources/add_content/standards/05rm/html/RM-2-")+ +++ one +++ (if has then [C '-'] else []) +++ two +++ (map C ".html") +++ [C ' '] +++ (if has then one ++ [C '.'] ++ two else+ (map C "Annex ") ++ one ++ [C ':'])+ ++ [C ' '] ++ (Map.findWithDefault [] "title" ll))+ st+ ""))+ where one = (Map.findWithDefault [] "1" ll)+ two = (Map.findWithDefault [] "2" ll)+ has = Map.member "2" ll+templateProcessor st ("Ada/2012/RM", ll)+ = (st,+ (linkToLaTeX+ ((map C "http://www.ada-auth.org/standards/12rm/html/RM-") +++ one +++ (if has then [C '-'] else []) +++ two +++ (map C ".html") +++ [C ' '] +++ (if has then one ++ [C '.'] ++ two else+ (map C "Annex ") ++ one ++ [C ':'])+ ++ [C ' '] ++ (Map.findWithDefault [] "title" ll))+ st+ ""))+ where one = (Map.findWithDefault [] "1" ll)+ two = (Map.findWithDefault [] "2" ll)+ has = Map.member "2" ll+templateProcessor st ("Fortran:Vorlage: Pre1", ll)+ = (st,+ "{\\ttfamily {\\scriptsize " +++ "\\newline{}" +++ s1 +++ "\\newline{}" +++ s2 +++ "\\newline{}" +++ (treeToLaTeX (Map.findWithDefault [] "1" ll) st) +++ "\\newline{}" +++ s2 ++ "\\newline{}" ++ s1 ++ "\\newline{}" ++ "}}\n")+ where s1+ = "0${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}.${\\ttfamily }${}|${\\ttfamily }${}${\\ttfamily }${}1${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}.${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}2${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}.${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}3${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}.${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}4${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}.${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}5${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}.${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}6${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}.${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}7${\\ttfamily }${}|${\\ttfamily }${}${\\ttfamily }${}.${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}${\\ttfamily }${}8"+ s2+ = "12345678901234567890123456789012345678901234567890123456789012345678901234567890"+templateProcessor st ("Fortran:Vorlage: Pre2", ll)+ = (st,+ "{\\bfseries Fortran 90/95-Code (free source form) }\\newline" +++ "{\\ttfamily {\\scriptsize " +++ (treeToLaTeX (Map.findWithDefault [] "1" ll) st) ++ "}}\n")+templateProcessor st ("Fortran:Vorlage: Pre3", ll)+ = (st,+ "{\\bfseries Programmcode} \\newline" +++ "{\\ttfamily {\\scriptsize " +++ (treeToLaTeX (Map.findWithDefault [] "1" ll) st) ++ "}}\n")+templateProcessor st ("Fortran:Vorlage: Pre4", ll)+ = (st,+ "{\\bfseries Fortran 2003-Code} \\newline" +++ "{\\ttfamily {\\scriptsize " +++ (treeToLaTeX (Map.findWithDefault [] "1" ll) st) ++ "}}\n")+templateProcessor st ("Fortran:Vorlage: Intrinsic", ll)+ = (st,+ "\\newline{}\n" +++ (treeToLaTeX (Map.findWithDefault [] "1" ll) st) +++ " = {\\bfseries " +++ (treeToLaTeX (Map.findWithDefault [] "2" ll) st) +++ "} ( " +++ (treeToLaTeX (Map.findWithDefault [] "3" ll) st) +++ " )\\newline{}\n")+templateProcessor st ("Fortran:Vorlage: IntrinsicS", ll)+ = (st,+ "\\newline{}\n {\\bfseries " +++ (treeToLaTeX (Map.findWithDefault [] "1" ll) st) +++ "} ( " +++ (treeToLaTeX (Map.findWithDefault [] "2" ll) st) +++ " )\\newline{}\n")+templateProcessor st ("Fortran:Vorlage: Isocbinding", ll)+ = (st,+ "Beispiel funktioniert mit Compiler\n" +++ "\\begin{myitemize}\n" +++ "\\item g95 (0.91!) May 10 2007: " +++ (treeToLaTeX (Map.findWithDefault [] "1" ll) st) +++ "\n" +++ "\\item gfortran 4.3.0 20070723 (experimental): " +++ (treeToLaTeX (Map.findWithDefault [] "2" ll) st) +++ "\n" +++ "\\item Intel Fortran Compiler 10.0: " +++ (treeToLaTeX (Map.findWithDefault [] "3" ll) st) +++ "\n" +++ "\\item Sun Studio Express - June 2007: " +++ (treeToLaTeX (Map.findWithDefault [] "4" ll) st) +++ "\n" +++ "\\end{myitemize}\n" +++ "Anmerkungen:\\newline{}\n" +++ (treeToLaTeX (Map.findWithDefault [] "5" ll) st) ++ "\n")+templateProcessor st ("C++-Programmierung/ Vorlage:Aufgabe", ll)+ = (st,+ ("{\\bfseries Aufgabe " +++ (treeToLaTeX (Map.findWithDefault [] "Nummer" ll) st) +++ "} \n" +++ (treeToLaTeX (Map.findWithDefault [] "Aufgabe" ll) st) +++ "\n {\\bfseries Musterl\246sung} \n" +++ (treeToLaTeX (Map.findWithDefault [] "L\246sung" ll) st) ++ " \n"))+templateProcessor st ("-", ll)+ = (tempProcAdapter $ mnfindentlatex ll) st+templateProcessor st ("Haskell speaker 2", ll) = (st, param "1")+ where param n = (treeToLaTeX (Map.findWithDefault [] n ll) st)+templateProcessor st ("Vorlage:LaTeX Mehrspaltig Anfang", ll)+ = (st, "\\begin{multicols}{" ++ (param "1") ++ "}")+ where param n = (treeToLaTeX (Map.findWithDefault [] n ll) st)+templateProcessor st ("Vorlage:LaTeX Mehrspaltig Ende", _)+ = (st, "\\end{multicols}")+templateProcessor st ("Vorlage:Referenzbox IntraBuch", ll)+ = (st,+ "{\\bfseries Querverweise:} Siehe auch " +++ (treeToLaTeX (Map.findWithDefault [] "1" ll) st))+templateProcessor st ("Referenzbox IntraBuch", ll)+ = (st,+ "{\\bfseries Querverweise:} Siehe auch " +++ (treeToLaTeX (Map.findWithDefault [] "1" ll) st))+templateProcessor st ("Referenzbox Internet", ll)+ = (st,+ "{\\bfseries Themenbezogene} " +++ (treeToLaTeX+ [Environment Wikilink (Str "")+ ((Map.findWithDefault [] "1" ll) ++ (map C "|Webangebote"))]+ st))+templateProcessor st ("Vorlage:Referenzbox Internet", ll)+ = (st,+ "{\\bfseries Themenbezogene} " +++ (treeToLaTeX+ [Environment Wikilink (Str "")+ ((Map.findWithDefault [] "1" ll) ++ (map C "|Webangebote"))]+ st))+templateProcessor st ("Referenzbox IntraReihe", ll)+ = (st,+ "{\\bfseries Zum anderen Band der " +++ (treeToLaTeX+ [Environment Wikilink (Str "")+ ((Map.findWithDefault [] "1" ll) +++ [C '|'] ++ (Map.findWithDefault [] "2" ll))]+ st)+ ++ "}" ++ (treeToLaTeX (Map.findWithDefault [] "3" ll) st))+templateProcessor st ("Vorlage:Referenzbox IntraReihe", ll)+ = (st,+ "{\\bfseries Zum anderen Band der " +++ (treeToLaTeX+ [Environment Wikilink (Str "")+ ((Map.findWithDefault [] "1" ll) +++ [C '|'] ++ (Map.findWithDefault [] "2" ll))]+ st)+ ++ "}" ++ (treeToLaTeX (Map.findWithDefault [] "3" ll) st))+templateProcessor st ("unicode", ll)+ = (st, (treeToLaTeX (Map.findWithDefault [] "1" ll) st))+templateProcessor st+ ("Praktikum Anorganische Chemie/ Vorlage:Infobox Nachweisreaktion",+ ll)+ = (st,+ "\\begin{tabular}{|p{0.3\\linewidth}|p{0.7\\linewidth}|}\\hline\n"+ +++ "\\multicolumn{2}{|p{1.0\\linewidth}|}{{\\bfseries Nachweisreaktion}} \\\\ \\hline\n"+ +++ "Reaktionstyp & " +++ (treeToLaTeX (Map.findWithDefault [] "Typ" ll) st) +++ " \\\\ \\hline\n" +++ "pH & " +++ (treeToLaTeX (Map.findWithDefault [] "pH" ll) st) +++ "\\\\ \\hline\n" +++ "Indikation & " +++ (treeToLaTeX (Map.findWithDefault [] "Indikation" ll) st) +++ "\\\\ \\hline \n\\end{tabular}\n")+templateProcessor st+ ("Praktikum Anorganische Chemie/ Vorlage:Gift", _)+ = (st, "{\\bfseries Gefahrstoffwarnung! $\\skull$ }")+templateProcessor st ("Wikibooks", ll)+ = (st, wikiLinkToLaTeX ((Map.findWithDefault [] "1" ll)) st)+templateProcessor st ("See also", ll)+ = (st,+ "See also: " +++ (wikiLinkToLaTeX ((Map.findWithDefault [] "1" ll)) st))+templateProcessor st ("info", ll)+ = (st,+ "\\begin{TemplateInfo}{}{}" +++ (treeToLaTeX ((Map.findWithDefault [] "1" ll)) st) +++ "\\end{TemplateInfo}")+templateProcessor st ("Java:statement1", _)+ = (st, "statement{$_{\\textrm{\\scriptsize 1}}$}")+templateProcessor st ("Java:statement2", _)+ = (st, "statement{$_{\\textrm{\\scriptsize 2}}$}")+templateProcessor st ("Java:boolean-condition", _)+ = (st, "boolean-condition")+templateProcessor st ("Java:ch", ll)+ = (st,+ "'" ++ (treeToLaTeX ((Map.findWithDefault [] "1" ll)) st) ++ "'")+templateProcessor st ("Ubung", _) = (st, "\\ubung")+templateProcessor st ("TickYes", _) = (st, "\\TickYes")+templateProcessor st ("Achtung", ll)+ = (st,+ "\\begin{TemplateInfo}{\\danger}{Achtung}" +++ (treeToLaTeX ((Map.findWithDefault [] "1" ll)) st) +++ "\\end{TemplateInfo}")+templateProcessor st ("Warning", ll)+ = (st,+ "\\begin{TemplateInfo}{\\danger}{Warning}" +++ (treeToLaTeX ((Map.findWithDefault [] "1" ll)) st) +++ "\\end{TemplateInfo}")+templateProcessor st ("warning", ll)+ = (st,+ "\\begin{TemplateInfo}{\\danger}{Warning}" +++ (treeToLaTeX ((Map.findWithDefault [] "1" ll)) st) +++ "\\end{TemplateInfo}")+templateProcessor st ("Notiz", ll)+ = (st,+ "\\begin{TemplateInfo}{}{Notiz}" +++ (treeToLaTeX ((Map.findWithDefault [] "1" ll)) st) +++ "\\end{TemplateInfo}")+templateProcessor st ("Vorlage:Zitat3", ll)+ = (st,+ "\\begin{longtable}{|p{\\linewidth}|}\\hline\n \\uline{" +++ (treeToLaTeX ((Map.findWithDefault [] "autor" ll)) st) +++ "}\\\\\\textit{\n" +++ (treeToLaTeX ((Map.findWithDefault [] "zitat" ll)) st) +++ "}\\scriptsize \\\\ \\RaggedLeft \\scriptsize \n" +++ (treeToLaTeX ((Map.findWithDefault [] "quelle" ll)) st) +++ "\\\\ \\hline \n\\end{longtable}\n")+templateProcessor st ("C++-Programmierung/ Vorlage:Frage", ll)+ = (st,+ if Map.member "Aufgabe" ll then+ ("\\begin{longtable}{|p{\\linewidth}|}\\hline\n {\\bfseries Aufgabe "+ +++ (treeToLaTeX (Map.findWithDefault [] "Nummer" ll) st) +++ "} \\\\ \\hline\n" +++ (treeToLaTeX (Map.findWithDefault [] "Aufgabe" ll) st) +++ "\\\\ \\hline\n {\\bfseries Musterl\246sung} \\\\ \\hline\n" +++ (treeToLaTeX (Map.findWithDefault [] "L\246sung" ll) st) +++ "\\\\ \\hline \n\\end{longtable}\n")+ else+ ("\\begin{longtable}{|p{\\linewidth}|}\\hline\n {\\bfseries Frage "+ +++ (treeToLaTeX (Map.findWithDefault [] "Nummer" ll) st) +++ "} \\\\ \\hline\n" +++ (treeToLaTeX (Map.findWithDefault [] "Frage" ll) st) +++ "\\\\ \\hline\n {\\bfseries Antwort} \\\\ \\hline\n" +++ (treeToLaTeX (Map.findWithDefault [] "Antwort" ll) st) +++ "\\\\ \\hline \n\\end{longtable}\n"))+templateProcessor st ("merke", ll)+ = (st,+ "\\begin{TemplateInfo}{}{" +++ heading +++ "}" +++ (treeToLaTeX ((Map.findWithDefault [] "1" ll)) st) +++ "\\end{TemplateInfo}")+ where heading+ = if Map.member "info" ll then+ treeToLaTeX (Map.findWithDefault [] "info" ll) st else "Hinweis"+templateProcessor st ("Merke", ll)+ = (st,+ "\\begin{TemplateInfo}{}{" +++ heading +++ "}" +++ (treeToLaTeX ((Map.findWithDefault [] "1" ll)) st) +++ "\\end{TemplateInfo}")+ where heading+ = if Map.member "info" ll then+ treeToLaTeX (Map.findWithDefault [] "info" ll) st else "Hinweis"+templateProcessor st+ ("Wie_mein_Buch_auf_die_Welt_kommt/_Vorlage:Zitat", ll)+ = templateProcessor st ("Zitat", ll)+templateProcessor st ("Zitat", ll)+ = (st,+ "\\begin{longtable}{|p{\\linewidth}|}\\hline\n" +++ (if Map.member "beschreibung" ll then+ (treeToLaTeX ((Map.findWithDefault [] "beschreibung" ll)) st) +++ "\\\\ \\hline"+ else "")+ +++ " \\uline{" +++ (treeToLaTeX+ ((Map.findWithDefault (Map.findWithDefault [] "Autor" ll) "autor"+ ll))+ st)+ +++ "}\\\\\\textit{\n" +++ (treeToLaTeX+ ((Map.findWithDefault (Map.findWithDefault [] "Zitat" ll) "zitat"+ ll))+ st)+ +++ "}\\scriptsize \\\\ \\RaggedLeft \\scriptsize \n" +++ (treeToLaTeX+ ((Map.findWithDefault (Map.findWithDefault [] "Quelle" ll) "quelle"+ ll))+ st)+ ++ "\\\\ \\hline \n\\end{longtable}\n")+templateProcessor st ("java web api", ll)+ = (st,+ "\\myhref{http://java.sun.com/javase/6/docs/api/" +++ loc ++ "}{" ++ cap ++ "}")+ where loc :: String+ loc = (shallowFlatten (Map.findWithDefault [] "1" ll))+ + cap :: String+ cap+ = "Java API: " ++ (treeToLaTeX (Map.findWithDefault [] "2" ll) st)+templateProcessor st+ ("Python_unter_Linux: Vorlagen:VorlageAusgabe", ll)+ = (st,+ ("\n{\\bfseries Ausgabe}\\\\\n{\\ttfamily \\scriptsize \n" +++ ("user\\@localhost:\\~\\$" +++ (treeToLaTeX+ (breakLines3 linewidth (Map.findWithDefault [] "1" ll))+ st)+ +++ "\\newline " +++ (treeToLaTeX+ (id+ (filter+ (\ x ->+ case x of+ C '\n' -> False+ (Environment Tag (TagAttr "br" _) _) -> True+ _ -> True)+ (Map.findWithDefault [] "2" ll)))+ st))+ ++ "}\n"))+templateProcessor st ("Python_unter_Linux: Vorlagen:VorlageQZ", ll)+ = (st,+ ("{\\ttfamily \\uline{" +++ (treeToLaTeX (breakLines3 100 (Map.findWithDefault [] "1" ll)) st)+ ++ "}}"))+templateProcessor st+ ("Python_unter_Linux: Vorlagen:VorlageQZ", ll)+ = (st,+ ("{\\ttfamily \\uline{" +++ (treeToLaTeX (breakLines3 100 (Map.findWithDefault [] "1" ll)) st)+ ++ "}}"))+templateProcessor st ("Python unter Linux: Vorlagen:VorlageQZ", ll)+ = (st,+ ("{\\ttfamily \\uline{" +++ (treeToLaTeX (breakLines3 100 (Map.findWithDefault [] "1" ll)) st)+ ++ "}}"))+templateProcessor st ("C++-Programmierung/ Vorlage:Syntax", ll)+ = (st,+ "{\\ttfamily {\\scriptsize " +++ (treeToLaTeX (breakLines3 96 (Map.findWithDefault [] "code" ll))+ st)+ ++ "}}\n")+templateProcessor st ("BigJava", ll)+ = tempProcAdapter+ (do x <- return+ ((replace2+ (replace2+ ("{\\ttfamily { " +++ ((formatLaTeXBlock defaultFormatOpts)+ (highlightAs "java"+ (shallowFlatten+ (map renormalize+ (breakLines3 96 (Map.findWithDefault [] "code" ll))))))+ ++ "}}\n")+ "\\begin{Shaded}"+ "")+ "\\end{Shaded}"+ ""))+ lll <- mapM doFonts x+ return (concat lll))+ st+templateProcessor st+ ("C++-Programmierung/ Vorlage:Kapitelanhang", ll)+ = (st,+ ((if Map.member "Zusammenfassung" ll then+ "\n {\\bfseries \\large Zusammenfassung} \n " +++ (treeToLaTeX (Map.findWithDefault [] "Zusammenfassung" ll) st)+ else "")+ +++ (if Map.member "Fragen" ll then+ "\n {\\bfseries \\large Fragen} \n " +++ (treeToLaTeX (Map.findWithDefault [] "Fragen" ll) st)+ else "")+ +++ (if Map.member "Aufgaben" ll then+ "\n {\\bfseries \\large Aufgaben} \n " +++ (treeToLaTeX (Map.findWithDefault [] "Aufgaben" ll) st)+ else "")+ ++ " \n"))+templateProcessor st ("code:Output", ll)+ = (st,+ ("{{" +++ (if (Map.member "1" ll) then+ "{ {" +++ (treeToLaTeX (breakLines3 96 (Map.findWithDefault [] "1" ll)) st)+ ++ "}}"+ else "")+ +++ "}}\n$\\text{ }$\\newline{}\n{\\bfseries Code}\\newline{}" +++ (if (Map.member "2" ll) then+ "{\\ttfamily {\\scriptsize" +++ (treeToLaTeX (breakLines3 96 (Map.findWithDefault [] "2" ll)) st)+ ++ "}}"+ else "")+ +++ (if (Map.member "3" ll) then+ "\n{\\bfseries Output}\\newline{}{\\ttfamily {\\scriptsize" +++ (treeToLaTeX (breakLines3 96 (Map.findWithDefault [] "3" ll)) st)+ ++ "}}"+ else "")))+templateProcessor st ("bcode:Example", ll)+ = (st,+ ("{\\bfseries Code}\\newline{}{\\ttfamily {\\scriptsize" +++ (if (Map.member "1" ll) then+ "{\\ttfamily {\\scriptsize" +++ (treeToLaTeX (breakLines3 96 (Map.findWithDefault [] "1" ll)) st)+ ++ "}}"+ else "")+ +++ "}}\n" +++ (if (Map.member "2" ll) then+ "{\\ttfamily {\\scriptsize" +++ (treeToLaTeX (breakLines3 96 (Map.findWithDefault [] "2" ll)) st)+ ++ "}}"+ else "")+ +++ (if (Map.member "3" ll) then+ "{\\ttfamily {\\scriptsize" +++ (treeToLaTeX (breakLines3 96 (Map.findWithDefault [] "3" ll)) st)+ ++ "}}"+ else "")))+templateProcessor st ("C++-Programmierung/ Vorlage:Code", ll)+ = (st,+ ("{\\ttfamily {\\scriptsize" +++ ((formatLaTeXBlock defaultFormatOpts)+ (highlightAs "c++"+ (shallowFlatten+ (map renormalize+ (breakLines3 96 (Map.findWithDefault [] "code" ll))))))+ +++ "}}\n" +++ (if (Map.member "output" ll) then+ "{\\bfseries Ausgabe}\n{\\ttfamily {\\scriptsize" +++ (treeToLaTeX (breakLines3 96 (Map.findWithDefault [] "output" ll))+ st)+ ++ "}}"+ else "")))+templateProcessor st ("cite web", ll) = (st, mainer)+ where mainer+ = "\\myhref{" +++ url +++ "}{" +++ title ++ "}. " ++ publisher ++ ". Retrieved " ++ accessdate ++ " "+ url = shallowFlatten (Map.findWithDefault [] "url" ll)+ publisher = treeToLaTeX (Map.findWithDefault [] "publisher" ll) st+ title = treeToLaTeX (Map.findWithDefault [] "title" ll) st+ accessdate+ = treeToLaTeX (Map.findWithDefault [] "accessdate" ll) st+templateProcessor st ("code", ll) = (st, mainer)+ where mainer :: String+ mainer+ = "\\TemplateCode{" +++ header +++ "}{" ++ "}{" ++ "}{" ++ "}{" ++ lang ++ "}{" ++ code ++ "}{}{}{}"+ + header :: String+ header+ = if Map.member "header" ll then+ (treeToLaTeX (Map.findWithDefault [] "header" ll)+ st{getInCode = True})+ else ""+ + lang :: String+ lang+ = if Map.member "lang" ll then+ (treeToLaTeX (Map.findWithDefault [] "lang" ll)+ st{getInCode = True})+ ++ " Source"+ else ""+ + code :: String+ code = trilexgen st{getInCode = True} ll "source"+templateProcessor st ("Java_Code_File", ll) = (st, mainer)+ where mainer :: String+ mainer+ = "\\TemplateCode{" +++ header +++ "}{" ++ "}{" ++ "}{" ++ "}{" ++ lang ++ "}{" ++ code ++ "}{}{}{}"+ + header :: String+ header+ = if Map.member "header" ll then+ (treeToLaTeX (Map.findWithDefault [] "header" ll)+ st{getInCode = True})+ else ""+ + lang :: String+ lang = if Map.member "lang" ll then "Java Source" else ""+ + code :: String+ code = trilexgen st{getInCode = True} ll "source"+templateProcessor st ("Syntax", ll) = (st, mainer)+ where mainer :: String+ mainer+ = "\\begin{TemplateCodeInside}{}{\\baselineskip}{\\baselineskip}{}{}{}\n"+ ++ code ++ "\n\\end{TemplateCodeInside}\n"+ + code :: String+ code = trilex st{getInCode = True} ll+templateProcessor st ("syntax", ll) = (st, mainer)+ where mainer :: String+ mainer+ = "\\begin{TemplateCodeInside}{}{\\baselineskip}{\\baselineskip}{}{}{}\n"+ ++ code ++ "\n\\end{TemplateCodeInside}\n"+ + code :: String+ code = trilex st{getInCode = True} ll+templateProcessor st ("HaskellGHCi", ll) = (st, mainer)+ where mainer :: String+ mainer+ = "\\begin{TemplateCodeInside}{}{\\baselineskip}{\\baselineskip}{}{}{}\n"+ ++ code ++ "\n\\end{TemplateCodeInside}\n"+ + code :: String+ code = trilexgen st{getInCode = True} ll "1"+templateProcessor st ("Java://", ll) = (st, mainer)+ where mainer :: String+ mainer+ = "\\begin{TemplateCodeInside}{}{\\baselineskip}{\\baselineskip}{}{}{}\n"+ ++ code ++ "\n\\end{TemplateCodeInside}\n"+ + code :: String+ code = trilexgen st{getInCode = True} ll "1"+templateProcessor st ("LaTeX/Usage", ll)+ = (st2,+ if (getInTab st > 0) then "\\TemplateSource{" ++ (rtrim x) ++ "}\n"+ else g)+ where f = shallowFlatten+ (map renormalize+ (breakLines3 linewidth (Map.findWithDefault [] "code" ll)))+ g = (formatLaTeXBlock defaultFormatOpts) (highlightAs "Latex" f)+ (x, st2)+ = runState (treeToLaTeX2 (breakLines3 linewidth (map C f))) st+templateProcessor st ("LaTeX/Example", ll)+ = (st2,+ "\\begin{longtable}{p{1.0\\linewidth}}\n" +++ g ++ "\\\\\n" ++ x ++ "\n\\end{longtable}")+ where f = shallowFlatten+ (map renormalize+ (breakLines3 linewidth (Map.findWithDefault [] "code" ll)))+ g = (formatLaTeXBlock defaultFormatOpts) (highlightAs "Latex" f)+ (x, st2)+ = runState (treeToLaTeX2 (Map.findWithDefault [] "render" ll)) st+templateProcessor st ("java://", ll) = (st, mainer)+ where mainer :: String+ mainer+ = "\\begin{TemplateCodeInside}{}{\\baselineskip}{\\baselineskip}{}{}{}\n"+ ++ code ++ "\n\\end{TemplateCodeInside}\n"+ + code :: String+ code = trilexgen st{getInCode = True} ll "1"+templateProcessor st ("java", ll) = (st, mainer)+ where mainer :: String+ mainer+ = "\\begin{TemplateCodeInside}{}{\\baselineskip}{\\baselineskip}{}{}{}\n"+ ++ code ++ "\n\\end{TemplateCodeInside}\n"+ + code :: String+ code = trilex st{getInCode = True} ll+templateProcessor st ("DOI", ll)+ = (st,+ "DOI:\\myhref{http://dx.doi.org/" ++ tl ++ "}{" ++ tx ++ "}")+ where tx = (treeToLaTeX (Map.findWithDefault [] "1" ll) st)+ tl = (shallowFlatten (Map.findWithDefault [] "1" ll))+templateProcessor st ("ISSN", ll)+ = (st,+ "\\myhref{http://dispatch.opac.d-nb.de/DB=1.1/CMD?ACT=SRCHA&IKT=8&TRM="+ ++ tl ++ "}{ISSN: " ++ tl ++ "}")+ where tl = (shallowFlatten (Map.findWithDefault [] "1" ll))+templateProcessor st ("cpp", ll)+ = (st,+ ("{\\ttfamily " +++ (treeToLaTeX (breakLines3 96 (Map.findWithDefault [] "1" ll)) st)+ ++ "}"))+templateProcessor st ("Schach: Vorlage:Schachbrett", _)+ = (st{getC = ((getC st) + 1)},+ "\n\n\\parbox[t]{" +++ mysize +++ "\\linewidth}{\n\\begin{center}\n" +++ "\\includegraphics[width=" +++ mysize +++ "\\linewidth,height=6.5in,keepaspectratio]{../images/chess" +++ n +++ ".pdf}\\end{center}\n" +++ "Stellung " ++ n ++ "}\\vspace{0.75cm}\n\n")+ where mysize = printf "%0.5f" (getF st)+ n = show (getC st)+templateProcessor st ("Farblegende", ll)+ = (st,+ if p then "\\legendColorBox" ++ col ++ "{" ++ param2 ++ "}\n" else+ "\\legendNamedColorBox{" ++ colname ++ "}{" ++ param2 ++ "}\n")+ where (p, colname, col)+ = colinfo (treeToLaTeX (Map.findWithDefault [] "1" ll) st)+ param2 = (treeToLaTeX (Map.findWithDefault [] "2" ll) st)+templateProcessor st ("Farbe", ll) = (st, defineall ++ inside)+ where (pred1, colname1, col1) = colinfo (param "1")+ (pred2, colname2, col2) = colinfo (param "2")+ param n = (treeToLaTeX (Map.findWithDefault [] n ll) st)+ trans = ((param "2") == "transparent")+ define p colname col+ = (if p then "\\definecolor{" ++ colname ++ "}{rgb}" ++ col else+ "")+ defineall+ = (define pred1 colname1 col1) ++ (define pred2 colname2 col2)+ inside+ = if trans then+ "\\textcolor{" ++ colname1 ++ "}{" ++ (param "3") ++ "}" else+ "\\fcolorbox{" +++ colname2 +++ "}{" +++ colname2 +++ "}{\\textcolor{" ++ colname1 ++ "}{" ++ (param "3") ++ "}}"+templateProcessor st ("cite paper", ll)+ = (st,+ (if Map.member "editor" ll then+ (treeToLaTeX (Map.findWithDefault [] "editor" ll) st) else+ (treeToLaTeX (Map.findWithDefault [] "author" ll) st))+ +++ (if Map.member "coauthor" ll then+ "; " ++ (treeToLaTeX (Map.findWithDefault [] "coauthor" ll) st)+ else "")+ +++ " " +++ (treeToLaTeX (Map.findWithDefault [] "date" ll) st) +++ ". " +++ (treeToLaTeX (Map.findWithDefault [] "title" ll) st) +++ "- " +++ (treeToLaTeX (Map.findWithDefault [] "publisher" ll) st) +++ ". pp. " +++ (treeToLaTeX (Map.findWithDefault [] "pages" ll) st) ++ "\n")+templateProcessor st ("Cite book", ll)+ = (st,+ (if Map.member "editor" ll then+ (treeToLaTeX (Map.findWithDefault [] "editor" ll) st) else+ (treeToLaTeX (Map.findWithDefault [] "author" ll) st))+ +++ " " +++ (treeToLaTeX (Map.findWithDefault [] "title" ll) st) +++ ". " +++ (treeToLaTeX (Map.findWithDefault [] "publisher" ll) st) +++ ", " +++ (treeToLaTeX (Map.findWithDefault [] "address" ll) st) +++ ", " +++ (treeToLaTeX (Map.findWithDefault [] "year" ll) st) ++ "\n")+templateProcessor st ("cite book", ll)+ = (st,+ (if Map.member "editor" ll then+ (treeToLaTeX (Map.findWithDefault [] "editor" ll) st) else+ (treeToLaTeX (Map.findWithDefault [] "author" ll) st))+ +++ " " +++ (treeToLaTeX (Map.findWithDefault [] "title" ll) st) +++ ". " +++ (treeToLaTeX (Map.findWithDefault [] "publisher" ll) st) +++ ", " +++ (treeToLaTeX (Map.findWithDefault [] "address" ll) st) +++ ", " +++ (treeToLaTeX (Map.findWithDefault [] "year" ll) st) ++ "\n")+templateProcessor st ("Cite article", ll)+ = (tempProcAdapter $ citearticle ll) st+templateProcessor st ("cite journal", ll)+ = (tempProcAdapter $ citearticle ll) st+templateProcessor st ("Citation", ll)+ = (tempProcAdapter $ citearticle ll) st+templateProcessor st ("Literatur", ll)+ = (tempProcAdapter $ citearticle ll) st+templateProcessor st ("cite techreport", ll)+ = (tempProcAdapter $ citearticle ll) st+templateProcessor st ("citation", ll)+ = (tempProcAdapter $ citearticle ll) st+templateProcessor st ("Cite episode", ll)+ = (tempProcAdapter $ citearticle ll) st+templateProcessor st ("cite newsgroup", ll)+ = (tempProcAdapter $ citearticle ll) st+templateProcessor st ("Ada/95/cite AI", ll)+ = (tempProcAdapter $ citearticle ll) st+templateProcessor st ("Ada/Cite cla", ll)+ = (tempProcAdapter $ citearticle ll) st+templateProcessor st ("cite", ll)+ = (tempProcAdapter $ citearticle ll) st+templateProcessor st ("cite news", ll)+ = (tempProcAdapter $ citearticle ll) st+templateProcessor st ("Druckversionsnotiz", _) = (st, "")+templateProcessor st ("meta", ll)+ = (st,+ wikiLinkToLaTeX+ ((C 'm') : (C ':') : (Map.findWithDefault [] "1" ll))+ st)+templateProcessor st ("Wikipedia", ll)+ = (st,+ wikiLinkToLaTeX+ ((C 'w') : (C ':') : (Map.findWithDefault [] "1" ll))+ st)+templateProcessor st ("Wikipedia2", ll)+ = (st,+ (wikiLinkToLaTeX+ ((C 'w') : (C ':') : (Map.findWithDefault [] "1" ll))+ st)+ +++ (wikiLinkToLaTeX+ ((C 'w') : (C ':') : (Map.findWithDefault [] "2" ll))+ st))+templateProcessor st ("GLSL Programming Unity SectionRef", ll)+ = (st,+ wikiLinkToLaTeX ((map (C) xx) ++ (Map.findWithDefault [] "1" ll))+ st)+ where xx+ = if+ shallowFlatten (Map.findWithDefault [] "1" ll) `elem`+ ["OpenGL ES 2.0 Pipeline", "Vertex Transformations",+ "Vector and Matrix Operations", "Applying Matrix Transformations",+ "Rasterization", "Per-Fragment Operations"]+ then "GLSL Programming/" else "GLSL Programming/Unity/"+templateProcessor st ("S", ll)+ = (st,+ wikiLinkToLaTeX+ (((C 's') : (C ':') : (Map.findWithDefault [] "1" ll)) +++ [C '|'] ++ (Map.findWithDefault [] "2" ll))+ st)+templateProcessor st ("wiktionary", ll)+ = (st,+ wikiLinkToLaTeX+ ((C 'w') :+ (C 'i') :+ (C 'k') : (C 't') : (C ':') : (Map.findWithDefault [] "1" ll))+ st)+templateProcessor st ("indent", ll) = (st, go)+ where go+ = case+ reads (shallowFlatten (Map.findWithDefault [] "1" ll)) ::+ [(Integer, String)]+ of+ [(n, _)] -> "\\newline{}" +++ (concat (genericReplicate n "{$\\text{ }$}"))+ _ -> "\\newline{}"+templateProcessor st ("wikipedia", ll)+ = (st,+ wikiLinkToLaTeX+ ((C 'w') : (C ':') : (Map.findWithDefault [] "1" ll))+ st)+templateProcessor st ("Wikiversity", ll)+ = (st,+ wikiLinkToLaTeX+ ((C 'v') : (C ':') : (Map.findWithDefault [] "1" ll))+ st)+templateProcessor st ("wikiquote", ll)+ = (st,+ wikiLinkToLaTeX+ ((C 'q') : (C ':') : (Map.findWithDefault [] "1" ll))+ st)+templateProcessor st ("W", ll)+ = (st,+ wikiLinkToLaTeX+ ((C 'w') : (C ':') : (Map.findWithDefault [] "1" ll))+ st)+templateProcessor st ("wp", ll)+ = (st,+ wikiLinkToLaTeX+ ((C 'w') : (C ':') : (Map.findWithDefault [] "1" ll))+ st)+templateProcessor st ("B", ll)+ = (st,+ wikiLinkToLaTeX+ ((C 'b') : (C ':') : (Map.findWithDefault [] "1" ll))+ st)+templateProcessor st ("Wikipedia-inline", ll)+ = (st,+ wikiLinkToLaTeX+ ((C 'w') : (C ':') : (Map.findWithDefault [] "1" ll))+ st)+templateProcessor st ("Wiktionary", ll)+ = (st,+ wikiLinkToLaTeX+ ((map C "wiktionary") +++ ((C ':') : (Map.findWithDefault [] "1" ll)))+ st)+templateProcessor st ("B3D:N2P/VTT1", ll) = (st2, r)+ where (r, st2)+ = runState+ (wikiImageToLaTeX+ ((C 'F') :+ (C 'i') :+ (C 'l') :+ (C 'e') :+ (C ':') :+ (Map.findWithDefault [] "image" ll) +++ [C '|'] +++ (Map.findWithDefault [] "imageWidth" ll) +++ [C '|'] ++ (Map.findWithDefault [] "text3" ll)))+ st+templateProcessor st ("Template:B3D:N2P/VTT1", ll) = (st2, r)+ where (r, st2)+ = runState+ (wikiImageToLaTeX+ ((C 'F') :+ (C 'i') :+ (C 'l') :+ (C 'e') :+ (C ':') :+ (Map.findWithDefault [] "image" ll) +++ [C '|'] +++ (Map.findWithDefault [] "imageWidth" ll) +++ [C '|'] ++ (Map.findWithDefault [] "text3" ll)))+ st+templateProcessor st ("Vorlage:Referenzen Zitat", ll) = (st, r)+ where r = (wikiLinkToLaTeX+ ((Map.findWithDefault [] "1" ll) +++ [C '|', C '['] ++ (Map.findWithDefault [] "2" ll) ++ [C ']'])+ st)+templateProcessor st ("Referenzen Zitat", ll) = (st, r)+ where r = (wikiLinkToLaTeX+ ((Map.findWithDefault [] "1" ll) +++ [C '|', C '['] ++ (Map.findWithDefault [] "2" ll) ++ [C ']'])+ st)+templateProcessor st ("wikipediapar", ll)+ = (st,+ wikiLinkToLaTeX+ ((C 'w') :+ (C ':') :+ (Map.findWithDefault [] (if Map.member "2" ll then "2" else "1")+ ll))+ st)+templateProcessor st ("Wikipediapar", ll)+ = (st,+ wikiLinkToLaTeX+ ((C 'w') :+ (C ':') :+ (Map.findWithDefault [] (if Map.member "2" ll then "2" else "1")+ ll))+ st)+templateProcessor st ("Kasten", ll)+ = (st,+ "\\LaTeXZeroBoxTemplate{" +++ (treeToLaTeX+ (Map.findWithDefault (Map.findWithDefault [] "inhalt" ll) "1" ll)+ st)+ ++ "}")+templateProcessor st ("Druckversion Titeleintrag", ll)+ = (st,+ "\\pagebreak{}\\begin{longtable}{|p{0.3\\linewidth}|p{0.7\\linewidth}|}\\hline\n"+ +++ "\\multicolumn{2}{|p{1.0\\linewidth}|}{\\bfseries Standardtiteleintrag}"+ +++ (if (Map.member "URL" ll) then+ "\\\\ \\hline\n \\fetchurlcaption & \\url{" +++ (treeToLaTeX (Map.findWithDefault [] "URL" ll) st) ++ "}"+ else "")+ +++ (if (Map.member "Buch" ll) then+ "\\\\ \\hline\n \\bookcaption & \\url{http://de.wikibooks.org/wiki/"+ +++ replace2 (treeToLaTeX (Map.findWithDefault [] "Buch" ll) st) " "+ "_"+ ++ "}"+ else "")+ +++ (if (Map.member "Sachgruppen" ll) then+ "\\\\ \\hline\n \\functionalgroupcaption & " +++ (treeToLaTeX (Map.findWithDefault [] "Sachgruppen" ll) st)+ else "")+ +++ (if (Map.member "WeitereThemen" ll) then+ "\\\\ \\hline\n \\futhertopicscaption & " +++ (treeToLaTeX (Map.findWithDefault [] "WeitereThemen" ll) st)+ else "")+ +++ (if (Map.member "Hauptautoren" ll) then+ "\\\\ \\hline\n \\mainauthorscaption & " +++ (treeToLaTeX (Map.findWithDefault [] "Hauptautoren" ll) st)+ else "")+ +++ (if (Map.member "Betreuer" ll) then+ "\\\\ \\hline\n \\projecttexniciancaption & " +++ (treeToLaTeX (Map.findWithDefault [] "Betreuer" ll) st)+ else "")+ +++ "\\\\ \\hline\n \\organizationscaptions & Wikibooks" +++ (if (Map.member "Erscheinungsdatum" ll) then+ "\\\\ \\hline\n \\datecaption & " +++ (treeToLaTeX (Map.findWithDefault [] "Erscheinungsdatum" ll) st)+ else "")+ +++ (if (Map.member "Standardnummer" ll) then+ "\\\\ \\hline\n \\standardcodecaption & " +++ (treeToLaTeX (Map.findWithDefault [] "Standardnummer" ll) st)+ else "")+ +++ (if (Map.member "Buch" ll) then+ "\\\\ \\hline\n \\maintitlecaption & " +++ (treeToLaTeX (Map.findWithDefault [] "Buch" ll) st)+ else "")+ +++ (if (Map.member "Verleger" ll) then+ "\\\\ \\hline\n \\publishercaption & " +++ (treeToLaTeX (Map.findWithDefault [] "Verleger" ll) st)+ else "")+ +++ (if (Map.member "Verlagsort" ll) then+ "\\\\ \\hline\n \\publishercitycaption & " +++ (treeToLaTeX (Map.findWithDefault [] "Verlagsort" ll) st)+ else "")+ +++ (if (Map.member "Regal" ll) then+ "\\\\ \\hline\n \\shelfcaption & " +++ (treeToLaTeX (Map.findWithDefault [] "Regal" ll) st)+ else "")+ +++ (if (Map.member "Umfang" ll) then+ "\\\\ \\hline\n \\sizecaption & " +++ (treeToLaTeX (Map.findWithDefault [] "Umfang" ll) st)+ else "")+ ++ "\\\\ \\hline \n\\end{longtable}\n")+templateProcessor st ("Druckversion Titelseite", ll)+ = (st{getTitle = s}, s)+ where s = (if (Map.member "Haupttitel" ll) then+ "\\mymaintitle{" +++ (treeToLaTeX (Map.findWithDefault [] "Haupttitel" ll)+ st{getInCenter = True})+ ++ "}"+ else "")+ +++ (if (Map.member "Untertitel" ll) then+ "\\mysubtitle{" +++ (treeToLaTeX (Map.findWithDefault [] "Untertitel" ll)+ st{getInCenter = True})+ ++ "}"+ else "")+ +++ (if (Map.member "Autor" ll) then+ "\\myauthor{" +++ (treeToLaTeX (Map.findWithDefault [] "Autor" ll)+ st{getInCenter = True})+ ++ "}"+ else "")+templateProcessor st ('j' : ('a' : ('v' : ('a' : (':' : xs)))), ll)+ = (tempProcAdapter $ javakeyword xs ll "java:") st+templateProcessor st ('J' : ('a' : ('v' : ('a' : (':' : xs)))), ll)+ = (tempProcAdapter $ javakeyword xs ll "Java:") st+templateProcessor st ("Haskell lib", ll)+ = (st, linkToLaTeX link st "")+ where param :: String -> Maybe [Anything Char]+ param name = Map.lookup name ll+ package+ = fromMaybe (map (C) "base") $ param "p" `mplus` param "package"+ version+ = fromMaybe (map (C) "4.1.0.0") $ param "v" `mplus` param "version"+ + unnamed :: Integer -> [Anything Char]+ unnamed i = fromMaybe [] $ param (show i)+ unnPars = takeWhile (not . null) $ map unnamed [1 ..]+ location+ = (map (C) "http://hackage.haskell.org/packages/archive/") +++ package +++ [C '/'] +++ version +++ (map (C) "/doc/html/") +++ (intercalate [C '-'] unnPars) ++ (map (C) ".html")+ caption = intercalate [C '.'] unnPars+ link = location ++ [C ' '] ++ caption+templateProcessor st ("V", ll)+ = (st,+ wikiLinkToLaTeX+ ((C 'v') : (C ':') : (Map.findWithDefault [] "1" ll))+ st)+templateProcessor st ("wikisource", ll)+ = (st,+ wikiLinkToLaTeX+ ((C 's') : (C ':') : (Map.findWithDefault [] "1" ll))+ st)+templateProcessor st ("M", ll)+ = (st,+ wikiLinkToLaTeX+ ((C 'm') : (C ':') : (Map.findWithDefault [] "1" ll))+ st)+templateProcessor st ("C", ll)+ = (st,+ "\\myhref{http://commons.wikimedia.org/wiki/" +++ loc ++ "}{" ++ cap ++ "}")+ where loc = (shallowFlatten (Map.findWithDefault [] "1" ll))+ + cap :: String+ cap+ = if (Map.member "2" ll) then+ (treeToLaTeX (Map.findWithDefault [] "2" ll) st) else+ (treeToLaTeX (Map.findWithDefault [] "1" ll) st)+templateProcessor st ("commons", ll)+ = (st,+ "\\myhref{http://commons.wikimedia.org/wiki/" +++ loc ++ "}{" ++ cap ++ "}")+ where loc = (shallowFlatten (Map.findWithDefault [] "1" ll))+ + cap :: String+ cap+ = if (Map.member "2" ll) then+ (treeToLaTeX (Map.findWithDefault [] "2" ll) st) else+ (treeToLaTeX (Map.findWithDefault [] "1" ll) st)+templateProcessor st ("Commonscat", ll)+ = (st,+ "\\myhref{http://commons.wikimedia.org/wiki/Category:" +++ loc ++ "}{" ++ cap ++ "}")+ where loc = (shallowFlatten (Map.findWithDefault [] "1" ll))+ + cap :: String+ cap+ = if (Map.member "2" ll) then+ (treeToLaTeX (Map.findWithDefault [] "2" ll) st) else+ (treeToLaTeX (Map.findWithDefault [] "1" ll) st)+templateProcessor st ("Commons", ll)+ = (st,+ "\\myhref{http://commons.wikimedia.org/wiki/" +++ loc ++ "}{" ++ cap ++ "}")+ where loc = (shallowFlatten (Map.findWithDefault [] "1" ll))+ + cap :: String+ cap+ = if (Map.member "2" ll) then+ (treeToLaTeX (Map.findWithDefault [] "2" ll) st) else+ (treeToLaTeX (Map.findWithDefault [] "1" ll) st)+templateProcessor st ("b", ll)+ = (st,+ wikiLinkToLaTeX+ ((C 'b') : (C ':') : (Map.findWithDefault [] "1" ll))+ st)+templateProcessor st ("Wikiquote", ll)+ = (st,+ wikiLinkToLaTeX+ ((C 'q') : (C ':') : (Map.findWithDefault [] "1" ll))+ st)+templateProcessor st ("Wikisource", ll)+ = (st,+ wikiLinkToLaTeX+ ((C 's') : (C ':') : (Map.findWithDefault [] "1" ll))+ st)+templateProcessor st ("Reaktion", ll)+ = (st, edukte ++ " $\\rightarrow$ " ++ produkte)+ where reput :: [String] -> [[Anything Char]] -> [[Anything Char]]+ reput (k : ks) out+ = if Map.member k ll then+ reput ks ((Map.findWithDefault [] k ll) : out) else reput ks out+ reput [] out = out+ + myjoin :: [[Anything Char]] -> String -> String+ myjoin (x : xs) acu+ = if xs == [] then+ (if acu == "" then (treeToLaTeX x st) else+ acu ++ "+" ++ (treeToLaTeX x st))+ else+ (if acu == "" then myjoin xs (treeToLaTeX x st) else+ myjoin xs acu ++ "+" ++ (treeToLaTeX x st))+ myjoin [] acu = acu+ edukte+ = myjoin (reput ["Edukt", "Edukt1", "Edukt2", "Edukt3"] []) ""+ produkte+ = myjoin (reput ["Produkt", "Produkt1", "Produkt2", "Produkt3"] [])+ ""+templateProcessor st ("Visual Basic .NET: Vorlage:Code", ll)+ = templateProcessor st ("C++-Programmierung/ Vorlage:Code", ll)+templateProcessor st ("Regal:Programmierung: Vorlage:Code", ll)+ = (st, mainer)+ where mainer :: String+ mainer+ = "\\TemplateCode{" +++ header +++ "}{" +++ footer +++ "}{" +++ marker +++ "}{}{" ++ output ++ "}{" ++ lang ++ "}{" ++ code ++ "}{}{}{}"+ + marker :: String+ marker+ = if Map.member "error" ll then "e" else+ if Map.member "valid" ll then "valid" else ""+ + header :: String+ header+ = if Map.member "kopf" ll then+ (treeToLaTeX (Map.findWithDefault [] "kopf" ll)+ st{getInCode = True})+ else ""+ + lang :: String+ lang+ = if Map.member "lang" ll then+ (treeToLaTeX (Map.findWithDefault [] "lang" ll)+ st{getInCode = True})+ ++ " Quelltext"+ else ""+ + code :: String+ code = trilex st{getInCode = True} ll+ + output :: String+ output+ = if Map.member "output" ll then+ (treeToLaTeX (killnbsp (Map.findWithDefault [] "output" ll))+ st{getInCode = True})+ else ""+ + footer :: String+ footer+ = if Map.member "fuss" ll then+ (treeToLaTeX (Map.findWithDefault [] "fuss" ll)+ st{getInCode = True})+ else ""+ killnbsp ((Environment HtmlChar (Str "nbsp") _) : xs) = xs+ killnbsp x = x+templateProcessor st (x, ll)+ = (tempProcAdapter $ unknownTemplate x ll) st++{-| This function is currently nearly unused, it is essentially the same as templateProcessor. But with this way of writing it down you can find out for which templates handler functions are registered. -}++templateRegistry ::+ [(String, Map String [Anything Char] -> Renderer String)]+templateRegistry+ = [("Regal:Programmierung: Vorlage:Code",+ \ ll ->+ let marker :: String+ marker+ = if Map.member "error" ll then "e" else+ if Map.member "valid" ll then "valid" else ""+ killnbsp ((Environment HtmlChar (Str "nbsp") _) : xs) = xs+ killnbsp x = x+ withdef x f+ = if Map.member x ll then+ (treeToLaTeX2 (f (Map.findWithDefault [] x ll))) else return ""+ in+ do st <- get+ put $ st{getInCode = True}+ code <- trilex2 ll+ footer <- withdef "fuss" id+ header <- withdef "kopf" id+ lang <- do x <- (withdef "lang" id)+ return $ if x == "" then "" else x ++ " Quelltext"+ output <- withdef "output" killnbsp+ st2 <- get+ put $ st2{getInCode = False}+ return $+ "\\TemplateCode{" +++ header +++ "}{" +++ footer +++ "}{" +++ marker +++ "}{" ++ output ++ "}{" ++ lang ++ "}{" ++ code ++ "}{}{}{}")]++{-| processing of Java keywords for the English wikibook on Java, each Java keyword got its own template there -}++javakeyword ::+ [Char] -> Map String [Anything Char] -> [Char] -> Renderer String+javakeyword xs ll j+ = if (xs `elem` keywords) then+ state $ \ st -> ("{\\bfseries " ++ xs ++ "}", st) else+ unknownTemplate (j ++ xs) ll+ where keywords+ = (["private", "int", "return", "void", "new", "class",+ "interface", "String", "null", "Object", "byte", "char", "short",+ "long", "double", "boolean", "if", "true", "static", "public",+ "protected", "extends", "throw", "catch", "throws", "try",+ "abstract", "false", "else", "switch", "continue", "import",+ "final", "break", "implements", "finally", "while", "string",+ "float", "do", "for", "case", "default", "package", "this"])++{-| Handler for the unknown template. That is the ones that no handler was registered for -}++unknownTemplate ::+ String -> Map String [Anything Char] -> Renderer String+unknownTemplate xx ll2+ = do st <- get+ let x = trim xx+ ll = Map.fromList (trimall (Map.toList ll2))+ trimall ((a, b) : xs) = ((trim a), b) : (trimall xs)+ trimall [] = []+ tm = (templateMap st)+ step_ttl y = treeToLaTeX2 (Map.findWithDefault [] y ll)+ maybe_known_sf+ = do lis <- Map.lookup x tm+ guard (not $ null lis)+ let (latexname : transparams) = lis+ guard (latexname /= "")+ return $+ do out <- mapM step_ttl transparams+ return $+ "\\" +++ latexname ++ "{" ++ (intercalate "}{" (map trim out)) ++ "}"+ unknown_sf+ = do uparams <- mapM step_ttl $ Map.keys ll+ return $+ "\n\nUNKNOWN TEMPLATE \n" +++ (drop 1 . nullinit $ show x) +++ "\n\n" ++ "{" ++ (intercalate "}{" uparams) ++ "}" ++ "\n\n"+ in fromMaybe unknown_sf maybe_known_sf++{-| helper function to generate image numbers for image in image galleries (gallery tag in mediawiki) the fist input parameter is the start number, the second the end number. A list of all numbers between start and end is returned -}++generateGINsHelper :: Int -> Int -> [Int]+generateGINsHelper b e+ = if b == e then [] else b : (generateGINsHelper (b + 1) e)++{-| function to generate image numbers for image in image galleries (gallery tag in mediawiki). The renderer start before the start of the gallery is given as first parameter. The state of the renderer after the end of the gallery is given as second parameter. A list containing the numbers of the images in the gallery is returned -}++generateGalleryImageNumbers :: MyState -> MyState -> [Int]+generateGalleryImageNumbers oldst newst+ = generateGINsHelper (getJ oldst) (getJ newst)++{-| strips center tags of the parse tree keeping the data inside the center tags in the parse tree, so just flattens out the center tags -}++uncenter :: [Anything t] -> [Anything t]+uncenter ((Environment Tag (TagAttr "center" _) l) : xs)+ = l ++ (uncenter xs)+uncenter ((Environment e s l) : xs)+ = (Environment e s (uncenter l)) : (uncenter xs)+uncenter (x : xs) = x : (uncenter xs)+uncenter [] = []++doFonts :: Char -> Renderer String+doFonts c+ = do st <- get+ case (fontStack st) of+ (x : _) -> if (getFont x c) == (font st) then return [c] else+ do put st{font = (getFont x c)}+ return ((fontsetter (getFont x c)) ++ (fontstyler x) ++ [c])+ _ -> return [c]++{-| converts a parse tree to latex. Takes the parse tree as first parameter. Takes the current state of the renderer as second input parameter. Returns the latex representation of the tree as return value. This function should only be used internally in latex renderer since it does not generate the table of names references for the ref tags. -}++treeToLaTeX :: [Anything Char] -> MyState -> String+treeToLaTeX l states = fst $ runState (treeToLaTeX2 l) states++{-| converts a parse tree to latex. Takes the parse tree as first parameter. Takes the current state of the renderer as second input parameter. Returns a tuple. the first element is the latex representation of the tree. The second is the new state of the renders. Does one run before the actual run, in order to generate a table of names references for the ref tags in mediawiki. This function should be called by the main program after the parser. -}++treeToLaTeX3 :: [Anything Char] -> MyState -> (String, MyState)+treeToLaTeX3 l st = runState ttl2twice st+ where ttl2twice+ = do _ <- treeToLaTeX2 l+ b <- get+ put st{fndict = fndict b}+ treeToLaTeX2 l++{-| converts a parse tree to latex. Takes the parse tree as first parameter. Takes the current state of the renderer as second input parameter. Returns the latex representation of the tree as Renderer String. So it actually takes the current state of the renderer as additional monadic input parameter and returns a possible modified version of it as additional monadic return parameter. This function should only be used internally in latex renderer since it does not generate the table of names references for the ref tags. -}++treeToLaTeX2 :: [Anything Char] -> Renderer String+treeToLaTeX2 ll+ = do x <- allinfo+ return $ concat x+ where allinfo :: Renderer [String]+ allinfo = mapM nodeToLaTeX (removeBr ll)+ + walk :: String -> [Anything Char] -> String -> Renderer String+ walk prefix l postfix+ = do d <- treeToLaTeX2 l+ return $ prefix ++ d ++ postfix+ + walktrim :: String -> [Anything Char] -> String -> Renderer String+ walktrim prefix l postfix+ = do st <- get+ put $ st{getInHeading = True}+ d <- treeToLaTeX2 l+ st2 <- get+ put $ st2{getInHeading = getInHeading st}+ return $ prefix ++ (trim d) ++ postfix+ + walkbf :: [Anything Char] -> Renderer String+ walkbf l+ = do st <- get+ put $+ st{lastFontChanged = True,+ fontStack =+ ((fromMaybe+ FontStyle{stylebase = Normal, bold = True, italic = False}+ (maybeHead (fontStack st))){bold = True}+ : (fontStack st))}+ d <- treeToLaTeX2 l+ st2 <- get+ put $ st2{fontStack = drop 1 (fontStack st2)}+ return $ "{\\bfseries " ++ (trim d) ++ "}"+ + walkit :: [Anything Char] -> Renderer String+ walkit l+ = do st <- get+ put $+ st{lastFontChanged = True,+ fontStack =+ ((fromMaybe+ FontStyle{stylebase = Normal, bold = False, italic = True}+ (maybeHead (fontStack st))){italic = True}+ : (fontStack st))}+ d <- treeToLaTeX2 l+ st2 <- get+ put $ st2{fontStack = drop 1 (fontStack st2)}+ return $ "{\\itshape " ++ (trim d) ++ "}"+ + walktt :: [Anything Char] -> Renderer String+ walktt l+ = do st <- get+ put $+ st{lastFontChanged = True,+ fontStack =+ ((fromMaybe+ FontStyle{stylebase = Mono, bold = False, italic = False}+ (maybeHead (fontStack st))){stylebase = Mono}+ : (fontStack st))}+ d <- treeToLaTeX2 l+ st2 <- get+ put $ st2{fontStack = drop 1 (fontStack st2)}+ return $ "{\\ttfamily " ++ (trim d) ++ "}"+ + walkfn :: String -> [Anything Char] -> String -> Renderer String+ walkfn prefix l postfix+ = do st <- get+ put $ st{getInFootnote = True}+ d <- treeToLaTeX2 l+ st2 <- get+ put $ st2{getInFootnote = (getInFootnote st)}+ return $ prefix ++ d ++ postfix+ + nodeToLaTeX :: Anything Char -> Renderer String+ nodeToLaTeX (C c)+ = do st <- get+ case (fontStack st) of+ (x : _) -> if (getFont x c) == (font st) then return (chartrans c)+ else+ do put+ st{font = (getFont x c),+ lastFontChanged = (lastFontChanged st) && (not (c == ' '))}+ return+ ((if ((lastFontChanged st) && (c == ' ')) then "{$\\text{ }$}"+ else "")+ +++ (fontsetter (getFont x c)) +++ (fontstyler x) ++ (chartrans c))+ _ -> return (chartrans c)+ nodeToLaTeX (Environment ForbiddenTag (Str s) _)+ = return $ s >>= chartrans+ nodeToLaTeX (Environment Wikitable (Str s) l)+ = do st <- get+ put $ st{getInTab = (getInTab st) + 1}+ d <- tableToLaTeX l s+ st2 <- get+ put $ st2{getInTab = (getInTab st)}+ return d+ nodeToLaTeX (Environment Wikitable (TagAttr _ a) l)+ = do st <- get+ put $ st{getInTab = (getInTab st) + 1}+ d <- tableToLaTeX l+ (if+ (Map.lookup "class" a) `elem`+ (map Just ["prettytable", "wikitable"])+ then "class=\"wikitable\"" else "")+ st2 <- get+ put $ st2{getInTab = (getInTab st)}+ return d+ nodeToLaTeX (Environment Wikilink _ l)+ = do st <- get+ if getInHeading st then return $ wikiLinkCaption l st else+ if (isImage (shallowFlatten l)) then wikiImageToLaTeX l else+ return $ wikiLinkToLaTeX l st+ nodeToLaTeX (Environment Link (Str s) l)+ = do st <- get+ if getInHeading st then+ return $ linkCaption l st s (getInFootnote st) else+ return $ linkToLaTeX l st s+ nodeToLaTeX (Environment Link2 (Str s) l)+ = nodeToLaTeX (Environment Link (Str s) l)+ nodeToLaTeX (Environment ItemEnv (Str _) [Item _]) = return []+ nodeToLaTeX (Environment ItemEnv (Str s) l)+ = do st <- get+ d <- if s == ";" then do fulllist else+ do ff <- treeToLaTeX2+ (if+ (s == ":") &&+ ([] ==+ [x | x <- l,+ not+ ((case x of+ Environment Math _ _ -> True+ Item _ -> True+ _ -> False)+ || (x `elem` (map (C) "\n\t \r;,.")))])+ then+ (shallowEnlargeMath+ [x | x <- l, not (x `elem` (map (C) "\n\t \r;,.:!?"))])+ else l)+ return [(ff, "")]+ if s /= ";" then+ return $+ "\n\\begin{" +++ (itemEnvironmentName s (getF st)) +++ "}" +++ (itemEnvironmentParameters s (getF st)) +++ (mmm2 d) +++ "\n\\end{" ++ (itemEnvironmentName s (getF st)) ++ "}\n"+ else return $ (prolist d st)+ where mmm2 d+ = case d of+ (x : _) -> fst x+ _ -> []+ texit v+ = do prep <- treeToLaTeX2 . prepart $ v+ post <- treeToLaTeX2 . postpart $ v+ return (prep, post)+ + fulllist :: Renderer [(String, String)]+ fulllist = mapM texit vv+ + vv :: [[Anything Char]]+ vv = [x | x <- splitOn [Item ';'] l, x /= []]+ prepart v = takeWhile ((/=) (C ':')) v+ postpart v+ = case dropWhile ((/=) (C ':')) v of+ (_ : xs) -> xs+ x -> x+ + prolist :: [(String, String)] -> MyState -> String+ prolist lis st+ = do (prd, pod) <- lis+ if pod == [] then (singlepart prd st) else (doublepart prd pod st)+ doublepart pre po st+ = "{\\bfseries" +++ "\n\\begin{" +++ (itemEnvironmentName s (getF st)) +++ "}" +++ (itemEnvironmentParameters s (getF st)) +++ pre +++ "\n\\end{" +++ (itemEnvironmentName s (getF st)) +++ "}\n" +++ "}" +++ "\n\\begin{" +++ (itemEnvironmentName ":" (getF st)) +++ "}" +++ (itemEnvironmentParameters s (getF st)) +++ (itemEnvironmentParameters s (getF st)) +++ (itemSeperator2 s) +++ po +++ "\n\\end{" +++ (itemEnvironmentName ":" (getF st)) ++ "}\n"+ singlepart pre st+ = "{\\bfseries" +++ "\n\\begin{" +++ (itemEnvironmentName s (getF st)) +++ "}" +++ (itemEnvironmentParameters s (getF st)) +++ pre +++ "\n\\end{" ++ (itemEnvironmentName s (getF st)) ++ "}\n" ++ "}\n"+ nodeToLaTeX (Item c) = return $ "\n" ++ (itemSeperator c) ++ " "+ nodeToLaTeX (Environment Itemgroup _ l) = walk "" l ""+ nodeToLaTeX (Environment Wikiheading (Str s) l)+ = do st <- get+ if (getInTab st) > 0 then+ walktrim ("{\\Large ") (uncenter l) ("}\n") else+ walktrim ("\\" ++ (getsec s) ++ "{") (uncenter l)+ ("}\n" ++ (getsecpost s))+ nodeToLaTeX (Environment Tag (TagAttr ('h' : (x : [])) _) l)+ = if x `elem` "123456" then+ case reads [x] of+ [] -> walk "" l ""+ ((y, _) : _) -> let s = replicate y '=' in+ walktrim ("\\" ++ (getsec s) ++ "{") (uncenter l)+ ("}\n" ++ (getsecpost s))+ else walk "" l ""+ nodeToLaTeX (Environment Bold _ l) = walkbf l+ nodeToLaTeX (Environment Italic _ l) = walkit l+ nodeToLaTeX (Environment Chapter _ l)+ = do d <- treeToLaTeX2 l+ return $ "\\chapter{" ++ (chapterTransform d) ++ "}\n\\myminitoc\n"+ nodeToLaTeX (Environment Tag (TagAttr "sup" _) l)+ = do st <- get+ walk ((fontsetter (font st)) ++ "\\textsuperscript{") l "}"+ nodeToLaTeX (Environment Tag (TagAttr "li" _) l)+ = walk "\\item{}" l ""+ nodeToLaTeX (Environment Tag (TagAttr "a" d) l)+ = do st <- get+ if getInHeading st then treeToLaTeX2 l else+ case Map.lookup "href" d of+ Just g -> return $+ linkToLaTeX+ ((map (C)+ (case g of+ '/' : ('/' : gx) -> "http://" ++ gx+ '/' : _ -> wikiUrlDataToString (urld st) g+ _ -> g))+ ++ [C ' '] ++ l)+ st+ ""+ Nothing -> treeToLaTeX2 l+ nodeToLaTeX (Environment Tag (TagAttr "ol" _) l)+ = do st <- get+ walk+ ("\n\\begin{" +++ (itemEnvironmentName "#" (getF st)) +++ "}" ++ (itemEnvironmentParameters "#" (getF st)))+ l+ ("\n\\end{" ++ (itemEnvironmentName "#" (getF st)) ++ "}\n")+ nodeToLaTeX (Environment Tag (TagAttr "dd" _) l)+ = do st <- get+ walk+ ("\n\\begin{" +++ (itemEnvironmentName ":" (getF st)) +++ "}" ++ (itemEnvironmentParameters ":" (getF st)) ++ "\n\\item{}")+ l+ ("\n\\end{" ++ (itemEnvironmentName ":" (getF st)) ++ "}\n")+ nodeToLaTeX (Environment Tag (TagAttr "ul" _) l)+ = do st <- get+ walk+ ("\n\\begin{" +++ (itemEnvironmentName "*" (getF st)) +++ "}" ++ (itemEnvironmentParameters "*" (getF st)))+ l+ ("\n\\end{" ++ (itemEnvironmentName "*" (getF st)) ++ "}\n")+ nodeToLaTeX (Environment Tag (TagAttr "dir" _) l)+ = do st <- get+ walk+ ("\n\\begin{" +++ (itemEnvironmentName "*" (getF st)) +++ "}" ++ (itemEnvironmentParameters "*" (getF st)))+ l+ ("\n\\end{" ++ (itemEnvironmentName "*" (getF st)) ++ "}\n")+ nodeToLaTeX (Environment Tag (TagAttr "strong" _) l) = walkbf l+ nodeToLaTeX (Environment Tag (TagAttr "dfn" _) l) = walkit l+ nodeToLaTeX (Environment Tag (TagAttr "var" _) l) = walkit l+ nodeToLaTeX (Environment Tag (TagAttr "q" _) l) = walkit l+ nodeToLaTeX (Environment Tag (TagAttr "sub" _) l)+ = do st <- get+ walk ((fontsetter (font st)) ++ "\\textsubscript{") l "}"+ nodeToLaTeX (Environment Tag (TagAttr "cite" _) l)+ = walk "\\newline\n \\quad {\\scshape " l "}"+ nodeToLaTeX (Environment Sup (Str s) _)+ = return $ "{$^{\\textrm{\\scriptsize " ++ s ++ "}}$}"+ nodeToLaTeX (Environment Sub (Str s) _)+ = return $ "{$_{\\textrm{\\scriptsize " ++ s ++ "}}$}"+ nodeToLaTeX (Environment Tag (TagAttr "u" _) l)+ = walk "\\uline{" l "}"+ nodeToLaTeX (Environment Tag (TagAttr "ins" _) l)+ = walk "\\uline{" l "}"+ nodeToLaTeX (Environment Tag (TagAttr "del" _) l)+ = walk "\\sout{" l "}"+ nodeToLaTeX (Environment Tag (TagAttr "strike" _) l)+ = walk "\\sout{" l "}"+ nodeToLaTeX (Environment Tag (TagAttr "b" _) l) = walkbf l+ nodeToLaTeX (Environment Tag (TagAttr "script" _) _)+ = walk "" [] ""+ nodeToLaTeX (Environment Tag (TagAttr "style" _) _) = walk "" [] ""+ nodeToLaTeX (Environment Tag (TagAttr "dt" _) l) = walkbf l+ nodeToLaTeX (Environment Tag (TagAttr "i" _) l) = walkit l+ nodeToLaTeX (Environment Tag (TagAttr "em" _) l) = walkit l+ nodeToLaTeX (Environment Tag (TagAttr "s" _) l)+ = walk "\\sout{" l "}"+ nodeToLaTeX (Environment Tag (TagAttr "small" _) l)+ = do st <- get+ if getInHeading st then walk "" l "" else walk "{\\small " l "}"+ nodeToLaTeX (Environment Tag (TagAttr "center" _) l)+ = do d <- treeToLaTeX2 (shallowEnlargeMath l)+ return $ "\n\\begin{center}\n" ++ d ++ "\n\\end{center}\n"+ nodeToLaTeX (Environment Tag (TagAttr "ref" a) l)+ = do st <- get+ case Map.lookup "name" a of+ Just n -> case Map.lookup n (fndict st) of+ Just lll -> go st lll+ Nothing -> if not (and (map (`elem` (map (C) " \r\n\t")) l)) then+ do put st{fndict = Map.insert n l (fndict st)}+ st2 <- get+ go st2 l+ else go st l+ Nothing -> go st l+ where go ss xx+ = if getInFootnote ss then walk "\\^{}\\{" xx "\\}" else+ walkfn "\\myfootnote{" xx "}"+ nodeToLaTeX (Environment Tag (TagAttr "includeonly" _) l)+ = walk "" l ""+ nodeToLaTeX (Environment Tag (TagAttr "blockquote" _) l)+ = walk "\\begin{myblockquote}\n\\item{}" l "\n\\end{myblockquote}"+ nodeToLaTeX (Environment Tag (TagAttr "code" _) l) = walktt l+ nodeToLaTeX (Environment Tag (TagAttr "kbd" _) l) = walktt l+ nodeToLaTeX (Environment Tag (TagAttr "samp" _) l) = walktt l+ nodeToLaTeX (Environment Tag (TagAttr "tt" _) l) = walktt l+ nodeToLaTeX (Environment Tag (TagAttr "big" _) l)+ = do st <- get+ if getInHeading st then walk "" l "" else walk "{\\large " l "}"+ nodeToLaTeX (Environment Tag (TagAttr "div" a) l)+ = let co+ = case Map.lookup "style" a of+ Nothing -> Nothing+ Just x -> case splitOn "background-color:" x of+ (_ : (y2 : [])) -> case splitOn ";" y2 of+ (z1 : _) -> case (trim z1) of+ ('#' : gs) -> let (p,+ _,+ col)+ = colinfo+ ('l'+ :+ 'l'+ :+ gs)+ in+ Just $+ if p+ then+ "\\definecolor{shadecolor}{rgb}"+ +++ col+ else+ "\\colorlet{shadecolor}{"+ +++ z1+ +++ "}"+ _ -> Just $+ "\\colorlet{shadecolor}{"+ ++ z1 ++ "}"+ _ -> Nothing+ _ -> Nothing+ beg+ = case co of+ Nothing -> ""+ Just x -> "\\LaTeXShadedColorBoxTemplate{" ++ x ++ "}{"+ en+ = case co of+ Nothing -> ""+ Just _ -> "}"+ in+ if (Map.member "class" a) then+ if (Map.findWithDefault [] "class" a) `elem` ["noprint", "topicon"]+ then return $ beg ++ en else walk beg l en+ else walk beg l en+ nodeToLaTeX (Environment Tag (TagAttr "span" a) l)+ = if (Map.member "class" a) then+ if+ ((Map.findWithDefault [] "class" a) `elem`+ ["noprint", "latitude", "longitude", "elevation"])+ || ((Map.findWithDefault [] "id" a) `elem` ["coordinates"])+ then return "" else walk "" l ""+ else walk "" l ""+ nodeToLaTeX (Environment Tag (TagAttr "br" _) _)+ = do st <- get+ return $+ if (getInCenter st) then "\\\\" else+ if (getInTab st) > 0 then "\\newline{}" else+ "$\\text{ }$\\newline{}\n"+ nodeToLaTeX (Environment Source (TagAttr _ a) l)+ = do let g = case reverse l of+ [] -> []+ (x : xs) -> if x == (C '\n') then reverse xs else l+ let xg+ = case g of+ (C '\n') : xs -> xs+ _ -> g+ let f = shallowFlatten (map renormalize (breakLines3 linewidth xg))+ let glines = (Map.lookup "line" a) /= Nothing+ let spg = splitOn "\n" f+ let spgl = length (show (length spg))+ let lino = linenumbers spgl 1 (length spg)+ let newlines+ = if glines then+ intercalate "\n" (map (\ (k, v) -> k ++ " " ++ v) (zip lino spg))+ else f+ d <- treeToLaTeX2+ (breakLines3 linewidth (if glines then map C newlines else xg))+ st <- get+ case+ do aa <- Map.lookup "lang" a+ guard (not (getInFootnote st))+ guard (not ((getInTab st) > 0))+ return aa+ of+ Just j -> do gg <- return $+ '\n' :+ replace2+ (replace2+ (replace2+ (replace2+ (replace2+ (replace2+ (replace2+ (replace2+ (replace2+ (replace2+ (replace2+ (replace2+ ((formatLaTeXBlock+ defaultFormatOpts)+ (highlightAs j+ newlines))+ "'"+ "\\textquotesingle{}")+ "\n"+ "\\newline\n")+ "{Shaded}\\newline\n"+ "{Shaded}\n")+ "{Highlighting}[]\\newline\n\\newline\n"+ "{Highlighting}[]\n")+ "{Highlighting}\\newline\n"+ "{Highlighting}\n")+ " "+ "\\ensuremath{\\text{ }}")+ "%"+ "\\%")+ "$"+ "\\$")+ "{Highlighting}[]\\newline\n"+ "{Highlighting}[]\n")+ "&"+ "\\&")+ "_"+ "\\_")+ "^"+ "\\^{}"+ lll <- mapM doFonts gg+ return (concat lll)+ Nothing -> return ("\\TemplateSource{" ++ (rtrim d) ++ "}\n")+ nodeToLaTeX (Environment Tag (TagAttr "font" a) l)+ = if Map.member "style" a then+ if+ ((Map.findWithDefault [] "style" a) == "text-decoration:overline")+ then walk "\\myoverline{" l "}" else walk "" l ""+ else walk "" l ""+ nodeToLaTeX (Environment Tag _ l) = walk "" l ""+ nodeToLaTeX (Environment Preformat (TagAttr _ _) l)+ = do d <- treeToLaTeX2 (breakLines3 linewidth l)+ return $ "\\TemplatePreformat{" ++ d ++ "}"+ nodeToLaTeX (Environment DhunUrl _ l)+ = do st <- get+ put st{currentUrl = shallowFlatten l}+ return ""+ nodeToLaTeX (Environment NoWiki _ l) = walk "" l ""+ nodeToLaTeX (Environment HDevLine _ l) = walk "" l ""+ nodeToLaTeX (Environment PageBreak _ _) = return "\\pagebreak "+ nodeToLaTeX (Quad) = return "$\\text{ }${}"+ nodeToLaTeX (Environment TableCap _ l) = walk "" l ""+ nodeToLaTeX (Tab)+ = return $ concat (take tabwidth (repeat "${\\text{ }}${}"))+ nodeToLaTeX (Environment SpaceIndent _ l)+ = if onlySpaces l then return "\n" else+ do st <- get+ z <- treeToLaTeX2 l+ put st+ if (all (\ x -> x `elem` "\r\n\t ") z) then return "" else+ do d <- treeToLaTeX2 (breakLines3 linewidth l)+ return $ (preput st) ++ "\\TemplateSpaceIndent{" ++ d ++ "}\n"+ where preput i = if getInCode i then "" else "\\\\\n\n"+ nodeToLaTeX (Environment Math _ l) = return $ mathToLatex l+ nodeToLaTeX (Environment BigMath _ l)+ = return $+ "\\begin{equation*}" ++ (mathTransform l) ++ "\\end{equation*}"+ nodeToLaTeX (Environment Greek (Str s) _)+ = return $ "{\\mbox{$\\" ++ s ++ "$}}"+ nodeToLaTeX (Environment P302 (Str s) _)+ = return $ "\\^{" ++ s ++ "}"+ nodeToLaTeX (Environment HtmlChar (Str s) _)+ = return $ getHtmlChar s+ nodeToLaTeX (Environment NumHtml (Str s) _)+ = return $+ case reads s of+ [] -> case+ do z <- case s of+ ('x' : xs) -> Just xs+ ('X' : xs) -> Just xs+ _ -> Nothing+ g <- unhex z+ return g+ of+ Just x -> chartrans . chr . fromIntegral $ x+ Nothing -> ("&#" ++ s ++ ";") >>= chartrans+ (x : _) -> chartrans . chr . fst $ x+ nodeToLaTeX (Environment Gallery _ l)+ = do st <- get+ put st{getInGallery = True}+ d <- galleryToLatex l+ st2 <- get+ put $ (newst st2){getInGallery = (getInGallery st)}+ return d+ where midst i = i{getInGallery = False}+ gins i = generateGalleryImageNumbers i (midst i)+ newst i+ = (midst i){getGalleryNumbers =+ (getGalleryNumbers (midst i)) ++ (map toInteger (gins i))}+ nodeToLaTeX (Environment ImageMap _ l)+ = treeToLaTeX2 (imageMapClean l)+ nodeToLaTeX (Environment Reserved (Str "·") _)+ = return "{\\mbox{$\\cdot$}}"+ nodeToLaTeX (Environment Template (Str s) l) = templateToLatex l s+ nodeToLaTeX (Environment Label (Str s) _)+ = return $ "\\label{" ++ s ++ "}"+ nodeToLaTeX _ = return []++{-| Unicode escaping for latex strings -}+ doUnicode :: String -> String doUnicode ('\206' : ('\178' : xs)) = "\\ensuremath{\\beta}" ++ doUnicode xs
src/Licenses.hs view
@@ -1,19 +1,30 @@-+{-| module storing information on image licensing on wikipedia wikimedia commons and so on. -} module Licenses where- ++{-| a map (written as list) to map an url to a license to an abbriviated text of the license. In contrast to the map minlicenses in this module the presence of a leading http: is optional -}+ licenses :: [(String, String)] licenses = minlicenses ++ (map go minlicenses)- where - go :: (String, String) -> (String, String)+ where go :: (String, String) -> (String, String) go (x, y) = ((drop 5) x, y)- ++{-| a map (written as list) to map an url to a license to an abbriviated text of the license -}+ minlicenses :: [(String, String)] minlicenses = [("http://en.wikipedia.org/wiki/public_domain", "PD"),+ ("https://en.wikipedia.org/wiki/Public_domain", "PD"),+ ("https://de.wikibooks.org/wiki/GNU_Freie_Dokumentationslizenz",+ "GFDL"),+ ("https://de.wikipedia.org/wiki/GNU-Lizenz_f%C3%BCr_freie_Dokumentation",+ "GFDL"),+ ("https://de.wikipedia.org/wiki/GNU-Lizenz_f\252r_freie_Dokumentation",+ "GFDL"), ("http://en.wikipedia.org/wiki/en:GNU_Free_Documentation_License", "GFDL"), ("http://en.wikipedia.org/wiki/en:GNU_General_Public_License", "GPL"),+ ("http://de.wikipedia.org/wiki/GNU_General_Public_License", "GPL"), ("http://de.wikipedia.org/wiki/Gemeinfreiheit", "PD"), ("http://en.wikipedia.org/wiki/de:Gemeinfreiheit", "PD"), ("http://de.wikipedia.org/wiki/Gemeinfreiheit", "PD"),@@ -40,6 +51,8 @@ ("http://creativecommons.org/licenses/by-sa/3.0/deed.en", "CC-BY-SA-3.0"), ("http://creativecommons.org/licenses/by-sa/3.0/deed.de",+ "CC-BY-SA-3.0"),+ ("https://creativecommons.org/licenses/by-sa/3.0/deed.de", "CC-BY-SA-3.0"), ("http://creativecommons.org/licenses/by-sa/3.0/cr/deed.en", "CC-BY-SA-3.0"),
src/Load.hs view
@@ -1,10 +1,13 @@-+{-| module to download the wiki source text form the wiki website -} module Load where import ImperativeState import Tools+import Hex import UrlAnalyse import Control.Monad.State-import Control.Monad.Error+import System.IO.Temp+import System.Directory+import System.FilePath.Posix import Text.ParserCombinators.Parsec hiding (try) import Text.Parsec.Prim import Codec.Binary.UTF8.String@@ -19,11 +22,10 @@ import WikiHelper import MediaWikiParseTree import MediaWikiParser-import Compiler import Network.URL-import Control.Concurrent-import Parallel- +import Control.Monad.Except+import System.Process+ notendyet :: (String -> ImperativeMonad String) -> ParsecT String () ImperativeMonad String ->@@ -42,7 +44,7 @@ <|> do a <- anyChar notendyet action sstart eend (aku ++ [a])- + beginning :: (String -> ImperativeMonad String) -> ParsecT String () ImperativeMonad String ->@@ -56,7 +58,7 @@ do _ <- sstart ne <- notendyet action sstart eend [] return (ne)- + startToEnd :: (String -> ImperativeMonad String) -> ParsecT String () ImperativeMonad String ->@@ -71,10 +73,10 @@ do a <- anyChar s <- startToEnd action sstart eend return (a : s)- + zeroAction :: (Monad m) => t -> t1 -> m [Char] zeroAction _ _ = return ""- + runAction :: String -> String ->@@ -89,7 +91,7 @@ case x of Left _ -> return "" Right xs -> return xs- + chapterAction :: WikiUrl -> String -> ImperativeMonad String chapterAction wurl text = do pp <- liftIO (getpage d (wurl))@@ -98,7 +100,7 @@ noinclude wurl ("\n\ndhunparserurl " ++ d ++ "\n\n" ++ p) _ -> return "" where d = (trim (takeWhile (/= '|') text))- + chapterAction2 :: FullWikiUrl -> String -> ImperativeMonad String chapterAction2 fu text = do pp <- liftIO (getpage d (wurl))@@ -110,19 +112,56 @@ where e = (trim (takeWhile (/= '|') text)) d = (removePrintVersion (lemma fu)) ++ "/" ++ e wurl = wikiUrl fu- -includeAction :: WikiUrl -> String -> ImperativeMonad String-includeAction = qIncludeAction- -qIncludeAction :: WikiUrl -> String -> ImperativeMonad String-qIncludeAction wurl text++chapterAction3 :: FullWikiUrl -> String -> ImperativeMonad String+chapterAction3 fu text = do pp <- liftIO (getpage d (wurl)) case pp of Just p -> do _ <- addContributors d Nothing- noinclude wurl ("\n\ndhunparserurl " ++ d ++ "\n\n" ++ p)+ noinclude wurl+ ("\n\ndhunparserurl " ++ d ++ "\n\n" ++ "= " ++ e ++ " =\n" ++ p) _ -> return ""+ where e = (trim (takeWhile (/= '|') text))+ d = (removePrintVersion (lemma fu)) ++ "/ " ++ e+ wurl = wikiUrl fu++includeAction :: WikiUrl -> String -> ImperativeMonad String+includeAction = qIncludeAction++qIncludeAction :: WikiUrl -> String -> ImperativeMonad String+qIncludeAction wurl text+ = if isInfixOf "Vorlage" text then return ("{{" ++ text ++ "}}")+ else+ do pp <- (liftIO (print d)) >> liftIO (getpage d (wurl))+ case pp of+ Just p -> do _ <- addContributors d Nothing+ noinclude wurl ("\n\ndhunparserurl " ++ d ++ "\n\n" ++ p)+ _ -> return "" where d = (trim (takeWhile (/= '|') text))- ++qBookIncludeAction :: WikiUrl -> String -> ImperativeMonad String+qBookIncludeAction wurl text+ = if isInfixOf "Vorlage" text then return ("{{" ++ text ++ "}}")+ else+ do pp <- (liftIO (print d)) >> liftIO (getBookpage d (wurl))+ case pp of+ Just p -> do _ <- addContributors d Nothing+ x <- noinclude wurl ("\n\ndhunparserurl " ++ d ++ "\n\n" ++ p)+ st <- get+ systempdir <- liftIO getTemporaryDirectory+ tempdir <- liftIO $+ createTempDirectory systempdir "MediaWiki2LaTeXParser"+ liftIO $ Tools.writeFile (tempdir </> "input") x+ _ <- liftIO $+ system+ ("mediawiki2latex -x " +++ (Hex.hex (show (fullconfigbase{compile = Just tempdir}))))+ t <- liftIO $ Tools.readFile (tempdir </> "output")+ put st{loadacu = ((read t) ++ (loadacu st) :: [Anything Char])}+ return x+ _ -> return ""+ where d = (trim (takeWhile (/= '|') text))+ makeUrl :: String -> String -> String -> [Char] makeUrl lang theFam thePage = (unify . exportURL)@@ -146,7 +185,7 @@ Absolute (Host{protocol = HTTP True, host = "toolserver.org", port = Nothing})}))- + langau :: Map String String langau = fromList@@ -167,7 +206,7 @@ ("ce", "\1071\1079\1076\1072\1088\1093\1086"), ("nl", "Auteurs"), ("es", "Autores"), ("eu", "Egile"), ("fr", "Auteurs"), ("cs", "Autor"), ("br", "Aozer")]- + makeHeader :: FullWikiUrl -> Maybe String -> [Char] makeHeader fullurl m = let mmm = m >>= (\ yy -> Map.lookup yy langau) in@@ -186,7 +225,24 @@ "\\label{Contributors}\n" ++ "\\begin{longtable}{rp{0.6\\linewidth}}\n" ++ "\\textbf{Edits}&\\textbf{User}\\\\\n"- ++makeHeaderHTML :: FullWikiUrl -> Maybe String -> [Char]+makeHeaderHTML fullurl m+ = let mmm = m >>= (\ yy -> Map.lookup yy langau) in+ "<h2>" +++ (case+ mmm `mplus`+ (case splitOn "." (hostname fullurl) of+ (x : _) -> Map.lookup x langau+ _ -> Nothing)+ `mplus` (Map.lookup "en" langau)+ of+ Just x -> x+ _ -> "Contributors")+ +++ "</h2>\n" +++ "<table rules=\"all\">" ++ "<tr><td>Edits</td><td>User</td></tr>"+ makeBody :: (Ord t) => Map t Contributor -> URL -> [Char] makeBody m u = concat (map go (sort (toList m))) where fun ('/' : xs) = xs@@ -197,11 +253,22 @@ (concat (map chartransforlink (exportURL (u{url_path = (fun (href v))})))) ++ "}{" ++ (concat (map chartrans (name v))) ++ "}\\\\\n"- -makeContributors :: Maybe URL -> ImperativeMonad String++makeBodyHTML :: (Ord t) => Map t Contributor -> URL -> [Char]+makeBodyHTML m u = concat (map go (sort (toList m)))+ where fun ('/' : xs) = xs+ fun xs = xs+ go (_, v)+ = "<tr><td>" +++ (show (edits v)) +++ "</td><td><a href=\"" +++ (((exportURL (u{url_path = (fun (href v))})))) +++ "\">" ++ (concat (map chartrans (name v))) ++ "</a></td></tr>"++makeContributors :: Maybe URL -> ImperativeMonad (String, String) makeContributors uu = do st <- get- li <- liftIO (mapM readMVar (audict st))+ li <- liftIO (return (audict st)) let myaudict = contribsum li let theUrl = case uu of@@ -213,50 +280,52 @@ ((Environment Tag (TagAttr _ m) _) : []) -> Map.lookup "lang" m _ -> Nothing return- ((makeHeader (fullUrl st) lang) ++- (makeBody (myaudict) (url (fullUrl st))) ++- "\\end{longtable}\n" ++ "\\pagebreak\n")- + (((makeHeader (fullUrl st) lang) +++ (makeBody (myaudict) (url (fullUrl st))) +++ "\\end{longtable}\n" ++ "\\pagebreak\n"),+ (makeHeaderHTML (fullUrl st) lang) +++ (makeBodyHTML (myaudict) (url (fullUrl st))) ++ "</table>")+ parseUrl :: String -> ImperativeMonad FullWikiUrl parseUrl u = case analyseFull u of Just x -> return x _ -> throwError (WikiUrlParseError u)- + getContributors :: [String] ->- ImperativeMonad- (MVar ([MVar (Map String Contributor)], [MVar (Maybe String)]))+ ImperativeMonad (([(Map String Contributor)], [(Maybe String)])) getContributors u = do st <- get- put imperativeStateZero+ stz <- liftIO imperativeStateZero+ put stz{counter = counter st} au <- mapM go u newState <- get put st- rr <- liftIO (newMVar (audict newState, au))+ rr <- liftIO (return (audict newState, au)) return rr where go uu = do purl <- parseUrl uu sst <- get put sst{fullUrl = purl} addContributors (lemma purl) (Just (UrlAnalyse.url purl))- + addContributors ::- [Char] -> Maybe URL -> ImperativeMonad (MVar (Maybe String))+ [Char] -> Maybe URL -> ImperativeMonad ((Maybe String)) addContributors theLemma uu = do sst <- get let st = fullUrl sst- thetheLemma <- liftIO . base $ theLemma- thetheHostname <- liftIO . base . hostname $ st- thetheUU <- liftIO . base $ uu- au <- (liftIO (((liftA3 fun) thetheLemma thetheHostname thetheUU)))- :: ImperativeMonad (MVar (Map String Contributor, Maybe String))- auau <- liftIO ((liftA (return . fst)) au)- lic <- liftIO ((liftA (return . snd)) au)+ thetheLemma <- liftIO $ return theLemma+ thetheHostname <- liftIO $ return (hostname st)+ thetheUU <- liftIO $ return uu+ au <- (liftIO ((((fun sst)) thetheLemma thetheHostname thetheUU)))+ :: ImperativeMonad ((Map String Contributor, Maybe String))+ auau <- liftIO (((return . fst)) au)+ lic <- liftIO (((return . snd)) au) put sst{audict = auau : (audict sst)} return lic- where fun lem ho uuu- = do xx <- simpleContributors lem ho uuu+ where fun ssst lem ho uuu+ = do xx <- simpleContributors lem ho uuu ssst return (Data.List.foldl runGo2 Map.empty xx, myvalue xx) runGo2 mymap (author, theHref, theEdits, _) = Map.alter (infun author theHref (fromIntegral theEdits)) author@@ -265,7 +334,7 @@ = case yy of [(_, __, _, Just lic)] -> (Just lic) _ -> Nothing- + infun :: String -> String -> Integer -> Maybe Contributor -> Maybe Contributor@@ -273,17 +342,17 @@ = case xx of Nothing -> Just Contributor{name = a, href = h, edits = e} Just old -> Just old{edits = (edits old) + e}- + noinclude :: t -> String -> ImperativeMonad [Char] noinclude wurl = runAction "<noinclude>" "</noinclude>" (zeroAction wurl)- + runActions :: FullWikiUrl -> String -> ImperativeMonad String runActions fu text = do x <- noinclude wurl text- y <- runAction "{{Druckversion Kapitel|" "}}" (chapterAction wurl)- x- z <- runAction "{{print entry|" "}}" (chapterAction2 fu) y+ y <- runAction "{{Druckversion Kapitel|" "}}" (chapterAction3 fu) x+ v <- runAction "{{Print entry|" "}}" (chapterAction2 fu) y+ z <- runAction "{{print entry|" "}}" (chapterAction2 fu) v a <- runAction "{{Print entry|" "}}" (chapterAction wurl) z b <- runAction "{{:" "}}" (includeAction wurl) a c <- runAction "{{:" "}}" (qIncludeAction wurl) b@@ -297,7 +366,13 @@ _ <- runAction "{{:" "}}" (qIncludeAction wurl) i runAction "{{:" "}}" (qIncludeAction wurl) j where wurl = wikiUrl fu- ++runBookActions :: FullWikiUrl -> String -> ImperativeMonad String+runBookActions fu text+ = do x <- noinclude wurl text+ runAction "[[" "]]" (qBookIncludeAction wurl) x+ where wurl = wikiUrl fu+ replacements :: String -> String replacements x = replace2@@ -311,7 +386,7 @@ "\n|") "{{Fortran:Vorlage: Table}}" "prettytable"- + loadPlain :: ImperativeState -> Maybe URL -> ImperativeMonad [Char] loadPlain st uu = let fu = fullUrl st in@@ -320,14 +395,40 @@ Just p -> do _ <- addContributors (lemma fu) uu runActions fu p _ -> throwError (DownloadError (lemma fu) (exportURL (url fu)))- ++loadBook :: ImperativeState -> Maybe URL -> ImperativeMonad [Char]+loadBook st uu+ = let fu = fullUrl st in+ do pp <- liftIO (getpage (lemma fu) (wikiUrl fu))+ case pp of+ Just p -> do _ <- addContributors (lemma fu) uu+ runBookActions fu p+ _ -> throwError (DownloadError (lemma fu) (exportURL (url fu)))+ loadHTML :: ImperativeState -> ImperativeMonad String loadHTML st = let fu = fullUrl st in- do _ <- loadPlain st (Just (url fu))+ do midst <- get+ (res, newst) <- liftIO+ (runStateT (runExceptT (loadPlain st (Just (url fu)))) midst)+ case res of+ Right _ -> put newst+ _ -> return () x <- liftIO (geturl2 (exportURL (url fu))) return . decode . unpack $ x- ++loadBookHTML :: ImperativeState -> ImperativeMonad String+loadBookHTML st+ = let fu = fullUrl st in+ do midst <- get+ (res, newst) <- liftIO+ (runStateT (runExceptT (loadPlain st (Just (url fu)))) midst)+ case res of+ Right _ -> put newst+ _ -> return ()+ x <- liftIO (geturl2 (exportURL (url fu)))+ return . decode . unpack $ x+ loadMediaWiki :: ImperativeState -> ImperativeMonad [Char] loadMediaWiki st = let fu = fullUrl st in@@ -355,12 +456,15 @@ throwError (DownloadError (lemma fu) (exportURL (url fu))) _ -> throwError (DownloadError (lemma fu) (exportURL (url fu)))- ++{-| main function to download images form the wiki. It takes the RunMode as only parameter. In case of HTML the html from the website is loaded. In all other cases the wiki source text is downloaded. In case of ExpandedTemplates the templates are also expanded by mediawiki running on the wiki website -}+ load :: RunMode -> ImperativeMonad String load theRunMode = do st <- get case theRunMode of HTML -> loadHTML st+ Book -> loadBook st Nothing UserTemplateFile _ -> loadPlain st Nothing StandardTemplates -> loadPlain st Nothing ExpandedTemplates -> loadMediaWiki st
src/Logger.hs view
@@ -1,6 +1,8 @@-+{-| module for logging currently unused -} module Logger where import ImperativeState- ++{-| initilaize logging facility -}+ minInit :: ImperativeMonad () minInit = return ()
src/MagicStrings.hs view
@@ -1,12 +1,12 @@-{-DHUN| This module provides string constants DHUN-}+{-| This module provides string constants -} module MagicStrings where import Data.Char import Network.URI import Data.List.Split import qualified Data.Map as Map- -{-DHUN| Wikimedia project prefixes so 'de' from de.wikipedia.org DHUN-}- ++{-| Wikimedia project prefixes so 'de' from de.wikipedia.org -}+ foreignPrefixes :: [String] foreignPrefixes = ["af", "als", "an", "roa-rup", "ast", "gn", "av", "ay", "az",@@ -32,9 +32,9 @@ "kn", "ks", "ml", "mr", "ne", "new", "or", "pa", "sa", "si", "ta", "te", "km", "lo", "th", "am", "ti", "iu", "chr", "ko", "ja", "zh", "wuu", "lzh", "yue"]- -{-DHUN| Wikimedia projects for interwiki links [[w:Foobar]] means en.wikipedia.org/wiki/Foobar DHUN-}- ++{-| Wikimedia projects for interwiki links [[w:Foobar]] means en.wikipedia.org/wiki/Foobar -}+ multilangwikis :: [(String, String)] multilangwikis = ([("w", "wikipedia"), ("wikipedia", "wikipedia"),@@ -48,31 +48,31 @@ ++ [("wikispecies", "wikispecies"), ("v", "wikiversity"), ("wikiversity", "wikiversity")])- -{-DHUN| Wikimedia projects for interwiki links to wikis which only have got a single language version DHUN-}- ++{-| Wikimedia projects for interwiki links to wikis which only have got a single language version -}+ singlelangwikis :: [(String, String)] singlelangwikis = [("wikimedia", "wikimediafoundation"), ("foundation", "wikimediafoundation"), ("wmf", "wikimediafoundation"), ("mw", "mediawiki")]- -{-DHUN| Wikimedia projects for interwiki links to wikis which only have got a single language version DHUN-}- ++{-| Wikimedia projects for interwiki links to wikis which only have got a single language version -}+ wikimediasingellangwikis :: [(String, String)] wikimediasingellangwikis = [("commons", "commons"), ("metawikipedia", "meta"), ("meta", "meta"), ("m", "meta"), ("incubator", "incubator"), ("strategy", "strategy")]- -{-DHUN| All Wikis DHUN-}- ++{-| All Wikis -}+ allwikis :: [(String, String)] allwikis = multilangwikis ++ singlelangwikis ++ wikimediasingellangwikis- -{-DHUN| Prefixes for including images in wikis DHUN-}- ++{-| Prefixes for including images in wikis -}+ imgtags :: [[Char]] imgtags = [map toLower x |@@ -96,22 +96,22 @@ "\1057\1083\1080\1082\1072", "Bild", "\3652\3615\3621\3660", "Talaksan", "Dosya", "\1496\1506\1511\1506", "\22294\20687", "\22294\20687"]]- -{-DHUN| lower Greek letter for HTML entity to latex so δ to \\delta DHUN-}- ++{-| lower Greek letter for HTML entity to latex so δ to \\delta -}+ lowergreek :: [[Char]] lowergreek = ["alpha", "beta", "gamma", "delta", "epsilon", "zeta", "eta", "theta", "iota", "kappa", "lambda", "mu", "nu", "xi", "pi", "rho", "sigma", "tau", "upsilon", "phi", "chi", "psi", "omega"]- -{-DHUN| not Greek but to be processed like the Greeks above DHUN-}- ++{-| not Greek but to be processed like the Greeks above -}+ notsogreek :: [[Char]] notsogreek = ["cap", "cup", "sim"]- -{-DHUN| Full list of characters with Greek like processing explained above DHUN-}- ++{-| Full list of characters with Greek like processing explained above -}+ greek :: [[Char]] greek = concat@@ -120,9 +120,9 @@ (x : xs) -> return [(toUpper x) : xs] [] -> return []) ++ lowergreek ++ notsogreek- -{-DHUN| HTML entities to latex DHUN-}- ++{-| HTML entities to latex -}+ htmlchars :: [([Char], [Char])] htmlchars = [("thetasym", "{\\mbox{$\\vartheta$}}"),@@ -505,26 +505,30 @@ ("zwnj", "{}"), ("zwj", ""), ("lrm", ""), ("rlm", ""), ("gt", "{\\mbox{$>$}}"), ("Mu", "{\\mbox{$\\Mu$}}"), ("#151", "{--}"), ("Nu", "{\\mbox{$\\Nu$}}"), ("frasl", "\8260")]- -{-DHUN| get latex representation of HTML entity like & DHUN-}- ++{-| get latex representation of HTML entity like & -}+ getHtmlChar :: String -> String getHtmlChar x = Map.findWithDefault [] x (Map.fromList htmlchars)- ++{-| a function to remove the taling print version string from urls (usually on wikibooks). This function is needed so the name of the book without the tailing print version string will be printed on the titlepage of the book -}+ removePrintVersion :: [Char] -> [Char] removePrintVersion lem = fun- ["/Print version", "/Complete Wikibook", "/All Chapters",- "/Print Version", "/print version", "/Printable version", "/The Whole Book"]+ ["/Druckversion", "/ Druckversion", "/Print version",+ "/Complete Wikibook", "/All Chapters", "/Print Version",+ "/print version", "/Printable version", "/The Whole Book",+ "/print", ": Druckversion"] lem where fun (y : ys) x = case splitOn y x of (z : _) -> fun ys z _ -> [] fun [] x = x- -{-DHUN| Nearly all HTML tags DHUN-}- ++{-| Nearly all HTML tags -}+ goodtags1 :: [[Char]] goodtags1 = ["includeonly", "references", "blockquote", "noinclude",@@ -534,30 +538,30 @@ "strike", "object", "input", "center", "legend", "iframe", "small", "video", "audio", "style", "input", "label", "tbody", "thead", "title", "frame", "param", "base", "area", "font", "code", "span",- "abbr", "body", "link", "menu", "meta", "samp", "cite", "head",- "html", "poem", "form", "cite", "ref", "div", "pre", "sub", "sup",- "big", "del", "map", "bdo", "var", "dfn", "kbd", "col", "ins",- "dir", "img", "h1", "h2", "h3", "h4", "h5", "h6", "li", "ul", "ol",- "tt", "dd", "dl", "dt", "hr", "em", "b", "i", "s", "u", "p", "q",- "a"]- -{-DHUN| HTML tags for tables rows in tables and so on, only lower case DHUN-}- + "abbr", "body", "link", "menu", "math", "meta", "samp", "cite",+ "head", "html", "poem", "form", "cite", "ref", "div", "pre", "sub",+ "sup", "big", "del", "map", "bdo", "var", "dfn", "kbd", "col",+ "ins", "bdi", "dir", "img", "h1", "h2", "h3", "h4", "h5", "h6",+ "li", "ul", "ol", "tt", "dd", "dl", "dt", "hr", "em", "b", "i",+ "s", "u", "p", "q", "a"]++{-| HTML tags for tables rows in tables and so on, only lower case -}+ tabletags :: [[Char]] tabletags = ["table", "td", "th", "tr"]- -{-DHUN| HTML tags for tables rows in tables and so on, lower case as well as upper case DHUN-}- ++{-| HTML tags for tables rows in tables and so on, lower case as well as upper case -}+ listOfTableTags :: [[Char]] listOfTableTags = tabletags ++ (map (map toUpper) tabletags)- -{-DHUN| All HTML tags DHUN-}- ++{-| All HTML tags -}+ listOfTags :: [[Char]] listOfTags = goodtags1 ++ (map (map toUpper) goodtags1)- -{-DHUN| Character escaping from Unicode to latex DHUN-}- ++{-| Character escaping from Unicode to latex -}+ chartrans :: Char -> String chartrans '\'' = "\\textquotesingle{}" chartrans '[' = "{$\\text{[}$}"@@ -576,10 +580,11 @@ chartrans '<' = "<{}" chartrans '>' = ">{}" chartrans '-' = "-{}"+chartrans '\8239' = "\\," chartrans c = c : []- -{-DHUN| Character escaping from Unicode to web links inside latex with the URL package DHUN-}- ++{-| Character escaping from Unicode to web links inside latex with the URL package -}+ chartransforlink :: Char -> String chartransforlink '&' = "\\&" chartransforlink '%' = "\\%"
− src/MakeChess.hs
@@ -1,6 +0,0 @@--module MakeChess where-import ImperativeState- -makeChess :: ImperativeMonad ()-makeChess = return ()
src/MediaWikiParseTree.hs view
@@ -1,9 +1,9 @@-{-DHUN| A module providing all necessary types of a parse tree for the representation of source written in the MediaWiki markup language DHUN-}+{-| A module providing all necessary types of a parse tree for the representation of source written in the MediaWiki markup language -} module MediaWikiParseTree where-import Data.Map (Map)- -{-DHUN| Lists the different environment possible in the mediawiki markup language and example of an environment is an HTML tag with everything included between the its opening and closing tags. Her is is called Tag DHUN-}- +import Data.Map.Strict (Map)++{-| Lists the different environment possible in the mediawiki markup language and example of an environment is an HTML tag with everything included between the its opening and closing tags. Her is is called Tag -}+ data EnvType = Wikilink | IncludeOnly | ImageMap@@ -51,23 +51,22 @@ | Parameter | NumHtml deriving (Show, Eq, Read)- -{-DHUN| A type representing a node in a the parse tree. Open and Close represent opening and closing bracket. They will be replace by environments (look at 'Environment' in this data structure) before the parse tree is processed further. The C represents a single character. S stands for a String. Tab is a special elements used like the tabulator character for line breaking purposes. Quad is similar to that. The Item... data construction are for processing itemization enumerations and so on and well be replace be environments before further processing DHUN-}- ++{-| A type representing a node in a the parse tree. Open and Close represent opening and closing bracket. They will be replace by environments (look at 'Environment' in this data structure) before the parse tree is processed further. The C represents a single character. S stands for a String. Tab is a special elements used like the tabulator character for line breaking purposes. Quad is similar to that. The Item... data construction are for processing itemization enumerations and so on and well be replace be environments before further processing -}+ data Anything a = Environment EnvType StartData [Anything a] | Open Int EnvType StartData Int | Close Int EnvType | C a- | S [a] | Item Char | ItemStop Char | ItemStart Char | Quad | Tab deriving (Show, Eq, Read)- -{-DHUN| represents the result of a parser for the begin of an environment. A parser for an opening HTML tag is an example. TagAttr means tag with attributes. And is thus a string for the element and a map from string to string for it attributes. Str is a String. And Attr is key value pair and used for attribute in tables. DHUN-}- ++{-| represents the result of a parser for the begin of an environment. A parser for an opening HTML tag is an example. TagAttr means tag with attributes. And is thus a string for the element and a map from string to string for it attributes. Str is a String. And Attr is key value pair and used for attribute in tables. -}+ data StartData = Str [Char] | TagAttr String (Map String String) | Attr (String, String)
src/MediaWikiParser.hs view
@@ -1,1722 +1,2034 @@-{-DHUN| A parser for the medaiiwki grammar DHUN-}-module MediaWikiParser where-import Text.ParserCombinators.Parsec-import qualified Data.List as List-import qualified Data.Map as Map-import MediaWikiParseTree-import MagicStrings-import Control.Monad-import Data.String.HT (trim)- -{-DHUN| A parser for one particular element of the mediawiki grammar DHUN-}- -data MyParser tok = MyParser{bad ::- [Anything tok] -> GenParser tok () (),- start :: MyStack tok -> GenParser tok () StartData,- end :: StartData -> GenParser tok () (), allowed :: [EnvType],- self :: EnvType,- modify :: StartData -> [Anything tok] -> [Anything tok],- reenv :: EnvType -> EnvType}- -{-DHUN| the stack of the parser. See documentation on MyStackFrame in this module for details. DHUN-}- -type MyStack tok = [MyStackFrame tok]- -{-DHUN| A stack frame on the parsers stack. A stack frame represents an environment that was opened. So something like an opening HTML tag. The value endparser. Is a parser that should match exactly the closing bracket of the environment. The value startdata is the return value of the start parser of the enviroment. This stack frame is created immediately after the startparser of an environment has matches and is given the return value of that startparser as startdata. The value environment is the environment this stack frame belongs to in case of an HTML tag this would be Tag. See the type EnvType in the module MediaWikiParseTree for a full list of possible environments. In the parse tree that is finally generated each node with arbitrarily nested children has got an EnvType associated with it. The badparser is a parser that is repeatedly tries while processing the current environment, if it matches the current environment is considered to be invalid. Backtracking occurs an the characters currently under consideration are parser (possible very) different manner. So with badparser you can signal that an environment is invalid if a creating parser (the badparser) matches within the environment. The parserenumber is just a number that uniquely identifies each parsers in the list of parsers active for the whole parsing process. These numbers are usually generated by the remake function. The nestingdepth is a bit of a misnomer. It is a unique number for each stack frame. So each stack frame that is newly created gets a different number. DHUN-}- -data MyStackFrame tok = MyStackFrame{endparser ::- GenParser tok () (),- startdata :: StartData, environment :: EnvType,- badparser :: [Anything tok] -> GenParser tok () (),- parsernumber :: Int, nestingdepth :: Int}- -{-DHUN| takes a result returned by parseAnything3 and converts it into a parse tree for further processing. The only purpose of this function is to convert the notation of bracket. The bracket a denoted by the Open and Close parse tree elements of the type Anything be the function parseAnything3. The need to be converted to environments, that is node with children in the parse tree. The environments will be denoted by the 'Environment' data constructors of the type Anything|DHUN-}- -decon2 ::- (Monad m) =>- [(a1, MyParser a)] -> m (t, [Anything a]) -> m [Anything a]-decon2 l x- = do (_, s) <- x- return (findMatchingBrackets l (reverse s))- -findMatchingBrackets3 :: [Anything Char] -> [Anything Char]-findMatchingBrackets3 = findMatchingBrackets (remake parsers)- -{-DHUN| Usually bracket can be close in an order different from the reverse one in which they were opened. But for certain environments this is not allowed, and the order has to be strictly followed. This value is the list of those environments. DHUN-}- -preserving :: [EnvType]-preserving- = [Math, Source, Comment, Gallery, NoWiki, NoInclude, BigMath,- Preformat, TableCap, TableRowSep, TableColSep, TableHeadColSep,- TemplateInside, Wikitable, TableTag]- -{-DHUN| Helper function for parseAnyClosingBracket. Should not be called directly. The only parameter is the current parser stack. Returns the depth on the stack of the stack frame whose closing bracket matched. DHUN-}- -parseAnyClosingBracket2 ::- (Show tok, Eq tok, Read tok) =>- MyStack tok -> GenParser tok () Integer-parseAnyClosingBracket2- = (parseAnyClosingBracket3 0) . (List.map (\ x -> endparser x))- -{-DHUN| Helper function for parseAnyClosingBracket. Should not be called directly. The this will take stack frame by stack frame of the stack. The first parameter is an integer and indicates how many stack frames have allready been take of the stack. Returns the depth on the stack of the stack frame whose closing bracket matched. DHUN-}- -parseAnyClosingBracket3 ::- Integer -> [GenParser tok () ()] -> GenParser tok () Integer-parseAnyClosingBracket3 i (x : xs)- = try- (do x- return i)- <|> (parseAnyClosingBracket3 (i + 1) xs)-parseAnyClosingBracket3 _ [] = pzero- -{-DHUN| Remove the n'th elements from a list. n is an integer an given is first parameter. The list to be processed is given as second parameter DHUN-}- -myremove :: Integer -> [a] -> [a]-myremove _ [] = []-myremove 0 (_ : xs) = myremove (-1) xs-myremove i (x : xs) = x : (myremove (i - 1) xs)- -{-DHUN| Enumerates a list of parsers. needed to prepare a list of parsers for use with parseAnything2 DHUN-}- -remake :: [a] -> [(Int, a)]-remake x = zip (iterate (+ 1) 0) x- -{-DHUN| predicate to test whether the current stack-frame-index is in a stack. The first parameter is the stack-frame-index the second parameter is the stack. Returns true if it could be found DHUN-}- -isin ::- (Show tok, Eq tok, Read tok) => Int -> (MyStack tok) -> Bool-isin i s = i `elem` (List.map nestingdepth s)- -{-DHUN| tries to parse exactly one specific opening bracket. The parameters are identical to the ones of parseAnyOpeningBracket, which the exception of the second parameter. The second parameter is that parser for the bracket currently under consideration. This function 'catch' the BBad 'exception' 'thrown' by parseAnything. In this case it returns pzero, causing the parser to backtrack. DHUN-}- -parseSpecificOpeningBracket ::- (Show tok, Eq tok, Read tok) =>- Int ->- (Int, MyParser tok) ->- (MyStack tok) ->- [(Int, MyParser tok)] ->- [Anything tok] ->- GenParser tok () (Either2 (MyStack tok, [Anything tok]))-parseSpecificOpeningBracket v (n, x) s l i- = do r <- do sd <- try (start x s)- parseAnything (v + 1)- (MyStackFrame{endparser = (end x) sd, startdata = sd,- environment = self x, badparser = bad x, parsernumber = n,- nestingdepth = v}- : s)- l- ((Open (length s) (self x) sd n) : i)- case r of- BBad (ss, y) -> if isin v ss then pzero else return (BBad (ss, y))- _ -> return r- -{-DHUN| tried to parse any of the opening brackets given by the parsers passed as the third parameter. The first parameter is the stack number (see documentation of the parseAnything function for more details on that). The second parameter is the current parser stack (see documentation of the parseAnything2 function for more details on that). The forth parameter is the list of parsers to b taken into account by the general parsing process. In contrast the third parameter contains only a list of parsers that are allowed to match in the current step of the parsing process. The fifth parameter is the current parser output stream. That is the information returned by the parser up to the current step. It is kind of an accumulator for parser results. DHUN-}- -parseAnyOpeningBracket ::- (Show tok, Eq tok, Read tok) =>- Int ->- MyStack tok ->- [(Int, MyParser tok)] ->- [(Int, MyParser tok)] ->- [Anything tok] ->- GenParser tok () (Either2 (MyStack tok, [Anything tok]))-parseAnyOpeningBracket _ _ [] _ _ = pzero-parseAnyOpeningBracket v s (x : xs) l i- = try (parseSpecificOpeningBracket v x s l i) <|>- parseAnyOpeningBracket v s xs l i- -{-DHUN| insert a list of closing brackets into the parser output stream. Later on matching opening and closing brackets will be found and parse tree will be generated this way. The first parameter is an integer it is the number of brackets which should be close. The second parameter is the parser stack. It says which kind of brackets should be closed. It returns a parser output stream just containing the opening brackets DHUN-}- -generateClosingBrackets ::- (Num a, Eq a, Show tok, Eq tok, Read tok) =>- a -> MyStack tok -> [Anything tok]-generateClosingBrackets 0 (s : xs)- = [Close (length xs) (environment s)]-generateClosingBrackets mi (s : xs)- = (Close (length xs) (environment s)) :- (generateClosingBrackets (mi - 1) xs)-generateClosingBrackets _ _ = []- -{-DHUN| insert a list of opening brackets into the parser output stream. Later on matching opening and closing brackets will be found and parse tree will be generated this way. The first parameter is an integer it is the number of brackets which should be opened. The second parameter is the parser stack. It says which kind of brackets should be opened. It returns a parser output stream just containing the opening brackets DHUN-}- -generateOpeningBrackets ::- (Num a, Eq a, Show tok, Eq tok, Read tok) =>- a -> MyStack tok -> [Anything tok]-generateOpeningBrackets 0 _ = []-generateOpeningBrackets mi (s : xs)- = (Open (length xs) (environment s) (startdata s) (parsernumber s))- : (generateOpeningBrackets (mi - 1) xs)-generateOpeningBrackets _ _ = []- -data Either2 b = RRight b- | BBad b- -{-DHUN| tries to match any of the currently possible closing brackets. Brackets closed in a order different from the reverse to the one in which they were opened are usually possible. And exception are the so called preserving elements, they can only be closed in the correct order. In the general case of this kind of crossbracketing it is necessary to add some opening and closing brackets to the output stream and to take the right stack frame of the stack keeping all others on it in the right order. DHUN-}- -parseAnyClosingBracket ::- (Show tok, Eq tok, Read tok) =>- Int ->- MyStack tok ->- [(Int, MyParser tok)] ->- [Anything tok] ->- GenParser tok () (Either2 (MyStack tok, [Anything tok]))-parseAnyClosingBracket v s l i- = do mi <- try- (do mmi <- parseAnyClosingBracket2 s- guard- (case s of- (g : _) -> (mmi == 0) ||- ((environment g) == Link2) ||- ((not ((environment g) `elem` preserving)) &&- (not- ((environment (s !! (fromIntegral mmi))) `elem`- preserving)))- [] -> False)- return mmi)- let ss = myremove mi s- parseAnything v ss l- ((reverse- ((generateClosingBrackets mi s) ++- (reverse (generateOpeningBrackets mi ss))))- ++ i)- -{-DHUN| this function tries to match the bad parser of the current environment. If it matches it returns BBAD, otherwise it returns RRight. See also comment of the parserAnything function. DHUN-}- -trybadparser ::- (Show tok, Eq tok, Read tok) =>- MyStack tok ->- [Anything tok] -> GenParser tok () (Either2 (MyStack tok, [a2]))-trybadparser s i- = do x <- case s of- (g : _) -> (do _ <- (badparser g) i- return True)- <|> return False- [] -> return False- if x == True then return (BBad (s, [])) else- return (RRight (s, []))- -{-DHUN| this is the main function of the parser which calls itself recursively. To run the parser you should not call this function directly but rather use parseAnything2. The parameter are the same as the parameters to the parameters to the function parseAnything2. So look at the documentation for their meaning. But there is one additional parameter namely the first one. This is the stack frame number, it is increase for every stack frame and never decreased this way each stack frame has got a unique identifier this way. An other difference is the return type this function returns the always same type as the function parseAnything2, but wrapped in the Either2 monad. The Either2 monad has an additional bit to signal whether the parse was good or bad. The bad bit signals so called bad parser of the current environment has matched signaling that the environment is to be considered invalid, and we have to backtrack. But what we do here is just stop paring and return a successful parse, but return the bad flag as set in the return type. This will propagate through to the parser that was trying to open the environment that caused the current problem. If that recognizes the problem it can flag the environment as failed by returning pzero. So again here we just return BBad. So we kind of throw an exception. And in parseSpecificOpeningBracket we will catch BBad and signal the actual problem by returning pzero and that way kick of backtracking. DHUN-}- -parseAnything ::- (Show tok, Eq tok, Read tok) =>- Int ->- MyStack tok ->- [(Int, MyParser tok)] ->- [Anything tok] ->- GenParser tok () (Either2 (MyStack tok, [Anything tok]))-parseAnything v s l i- = (do eof- return $ RRight (s, i ++ (generateClosingBrackets (length s) s)))- <|>- do nb <- trybadparser s i- case nb of- RRight _ -> try (parseAnyClosingBracket v s l i) <|>- case s of- (g : _) -> do try- (parseAnyOpeningBracket v s- [x | x <- l,- (environment g) `elem` (allowed (snd x))]- l- i)- [] -> return (RRight ([], i))- <|>- do c <- anyToken- parseAnything v s l ((C c) : i)- BBad _ -> case s of- (g : _) -> try- (parseAnyOpeningBracket v s- [x | x <- l, (environment g) `elem` (allowed (snd x))]- l- i)- <|> return (BBad (s, i))- [] -> pzero- -{-DHUN| This is the main entry point of the parse. So the function you need to call when you want to convert the source into the parse tree. The first parameter is the stack. I usually should contain only and exactly the root stack frame. The second parameter is an enumerated list of parsers. You usually take a list like the list parsers from this module and enumerate it by running remake on it. So thats the list of environments the parser is able to recognize. The third parameter is the parse results that have been created so far. Since we are just starting the parse this has to be the empty list. The function returns a parser. See the documentation of the parse module for more details on the type GenParser. Roughly is means that this parser takes an input list whose items are of type tok and that the parsers does not have state (hence the void type '()') and return a tuple. The first elements of that tuple is a stack. Where a new stack frame is added to the stack for each new environment that is found to open by the parser, like an opening HTML tag. And the second elements of the tuple is a parse tree, that is a list of parse tree elements, where each parse tree element may contain sublists of parse tree element. This way it is a real tree. DHUN-}- -parseAnything2 ::- (Show tok, Eq tok, Read tok) =>- MyStack tok ->- [(Int, MyParser tok)] ->- [Anything tok] -> GenParser tok () (MyStack tok, [Anything tok])-parseAnything2 s l i- = do x <- parseAnything 0 s l i- case x of- BBad (_, b) -> return (s, b)- RRight b -> return b- -{-DHUN| this find the matching closing bracket for an opening bracket. It returns a tuple. Its first element is the environment created form the given opening bracket together with its closing bracket and the content between opening and closing bracket. Its second elements is the remaining list of parsed elements, after the closing bracket. This list does still contain the Open and Close parser tree elements for opening and closing bracket, and those are not yet converted to environments. This function takes the list of parse tree elements after the opening bracket as first input parameter. It takes the index of the parser that created the opening bracket as second input parameter. That is the index created by the remake function in this module. It takes the size of the stack at the time when the opening bracket was found as third input parameter. It takes the EnvType of the environment of the opening bracket as fourth input parameter. It takes the StartData parse result associated with the opening bracket as fifth parameter. The sixth parameter is the accumulator an should be the empty list when calling this function externally. The seventh parameter is the remaining parse tree after the opening bracket without the opening and closing brackets converted to environments DHUN-}- -findMatchingClosingBracket ::- [(a1, MyParser a)] ->- Int ->- Int ->- EnvType ->- StartData ->- [Anything a] -> [Anything a] -> (Anything a, [Anything a])-findMatchingClosingBracket l n i e s b ((Close i2 e2) : xs)- = if (i, e) == (i2, e2) then- (Environment ((reenv (snd (l !! n))) e) s- ((modify (snd (l !! n))) s (findMatchingBrackets l (reverse b))),- xs)- else findMatchingClosingBracket l n i e s ((Close i2 e2) : b) xs-findMatchingClosingBracket l n i e s b (x : xs)- = findMatchingClosingBracket l n i e s (x : b) xs-findMatchingClosingBracket l n _ e s b []- = (Environment e s- ((modify (snd (l !! n))) s (findMatchingBrackets l (reverse b))),- [])- -{-DHUN| run findMatchingBrackets on the inner part environment given as second parameter. This function takes the enumerated list of parsers created by remake as first input parameter DHUN-}- -findMatchingBrackets2 ::- [(a1, MyParser a)] -> Anything a -> Anything a-findMatchingBrackets2 l (Environment e s b)- = Environment e s (findMatchingBrackets l b)-findMatchingBrackets2 l xs- = Environment Root (Str "") (findMatchingBrackets l [xs])- -{-DHUN| the parser (Anything3) creates a list of parser elements, which is not a tree. The environments which will form the nodes with children in the final tree are denoted as opening and closing brackets in this list. This function takes that list as second input parameter, finds matching pairs of opening and closing brackets and converts the to environments. The opening an closing brackets are already balanced because of the way Anything3 works, that means there is exactly one matching closing bracket for each opening one and they open and close in to proper order. This function takes the enumerated list of parsers as first input parameter, that is the same list also given to the function Anything. DHUN-}- -findMatchingBrackets ::- [(a1, MyParser a)] -> [Anything a] -> [Anything a]-findMatchingBrackets l xs = findMatchingBrackets4 l xs- -findMatchingBrackets4 ::- [(a1, MyParser a)] -> [Anything a] -> [Anything a]-findMatchingBrackets4 l ((Open i e s n) : xs)- = let (t, xxs) = findMatchingClosingBracket l n i e s [] xs in- (findMatchingBrackets2 l t) : (findMatchingBrackets4 l xxs)-findMatchingBrackets4 l (x : xs) = x : (findMatchingBrackets4 l xs)-findMatchingBrackets4 _ [] = []- -{-DHUN| a list of environments. Most parsers use this list as their 'allowed' variable. Meaning that the parser is only allowed to match within the environments given in the 'allowed' list DHUN-}- -everywhere :: [EnvType]-everywhere = [Wikitable] ++ everywheretbl- -{-DHUN| list containing the Italic and Bold environments, see documentation on the list 'everywhere' in this module DHUN-}- -bi :: [EnvType]-bi = [Italic, Bold]- -{-DHUN| list containing the same environments as the list 'everywhere' except the Wikitable environment, see documentation on the list 'everywhere' in this module DHUN-}- -everywheretbl :: [EnvType]-everywheretbl = bi ++ everywherebi- -{-DHUN| list containing the same environments as the list 'everywhere' except the environment Wikitable, Bold and Italic, see documentation on the list 'everywhere' in this module DHUN-}- -everywherebi :: [EnvType]-everywherebi = basicwhere ++ [Wikilink]- -{-DHUN| list containing the same environments as the list 'everywhere' except the environment Wikitable, Bold, Italic and Wikilink see documentation on the list 'everywhere' in this module DHUN-}- -basicwhere :: [EnvType]-basicwhere = [Link] ++ verybasicwhere- -{-DHUN| list containing the same environments as the list 'everywhere' except the environment Wikitable, Bold, Italic, Wikilink and Link see documentation on the list 'everywhere' in this module DHUN-}- -verybasicwhere :: [EnvType]-verybasicwhere- = [Itemgroup, Root, Wikiheading, TableCap, Chapter, Tag, TableTag,- TemplateInside, IncludeOnly]- -{-DHUN| list containing the environments where the parser linkp is allowed to match. Currently this seems to be everywhere. So this possibly can go away DHUN-}- -everywherel :: [EnvType]-everywherel = basicwhere ++ bi ++ [Wikitable, Wikilink]- -{-DHUN| list containing the same environments as the list 'everywhere' except the Link environment see documentation on the list 'everywhere' in this module DHUN-}- -everywherel2 :: [EnvType]-everywherel2 = verybasicwhere ++ bi ++ [Wikitable, Wikilink]- -{-DHUN| list containing the TableColSep and TableHeadColSep environments, see documentation on the list 'everywhere' in this module. the environments mean table header column separator and table column separator DHUN-}- -wikilinkwhere :: [EnvType]-wikilinkwhere = [TableColSep, TableHeadColSep]- -{-DHUN| the list of parsers needed for processing the HTML output created by MediaWiki DHUN-}- -minparsers :: [MyParser Char]-minparsers- = [doctagparser, metatagparser, supp, subp, dhunurlp, itagparser,- pagebreakp, htmlcharp, p302p, attrp, greekp, brparser, mytablep,- mytrsepp, mytcolsepp, mytcapp, mythcolsepp, tagparser, tagparserp,- tagparser2, tagparser2p, tagparsert, tagparsert, tagparser2t,- tagparsers, stagparser, commentp, numhtmlp, rtagparser]- -htmlminparsers :: [MyParser Char]-htmlminparsers- = [doctagparser, metatagparser, supp, subp, dhunurlp, itagparser,- pagebreakp, htmlcharp, p302p, attrp, greekp, brparser, htmytablep,- htmytrsepp, htmytcolsepp, htmytcapp, htmythcolsepp, tagparser,- tagparserp, tagparser2, tagparser2p, tagparsert, tagparsert,- tagparser2t, tagparsers, stagparser, commentp, numhtmlp,- rtagparser]- -{-DHUN| the list of parsers needed for processing the image title description so that is the content a html attibutes DHUN-}- -imgparsers :: [MyParser Char]-imgparsers = [supp, subp, htmlcharp, p302p, greekp, numhtmlp]- -{-DHUN| the list of parsers needed for parsing source code in the MediaWiki markup language DHUN-}- -parsers :: [MyParser Char]-parsers- = [doctagparser, metatagparser, supp, subp, dhunurlp, itagparser,- chapterp, prep, pagebreakp, htmlcharp, p302p, attrp, greekp,- brparser, wikilinkp, wikitablep, mytablep, wikiheadingp,- itempgrouppt, itempgroupp, itemlinep, boldp, italicp, tablecapp,- tablecapp2, tablecapp3, rowsepp, mytrsepp, colsepp, colsepp2,- mytcolsepp, mytcapp, headcolsepp, headcolsepp2, mythcolsepp,- galleryp, imagemapp, nowikip, noincludep, mathp, imagemapp,- ttagparser, ttagparser2, ttagparsert, ttagparser2t, ttagparsers,- tagparser, tagparser2, tagparsert, tagparser2t, tagparsers,- stagparser, commentp, reservedp, templatewikilinkp, wikiparamp,- wikitemplatep, templateinsideverbatimp, templateinsidep,- gallerywlp, imagemapwlp, hdevlinep, linkp, linkp2, presectionp,- numhtmlp, rtagparser]- -{-DHUN| the parser record, with some fields initialized with default values DHUN-}- -baseParser :: MyParser tok-baseParser- = MyParser{bad = \ _ -> pzero, start = undefined,- end = \ _ -> return (), allowed = everywhere, self = undefined,- modify = \ _ x -> x, reenv = id}- -{-DHUN| this function takes a string and returns a parser that matches any of the given strings DHUN-}- -oneOfTheStrings :: [String] -> Parser String-oneOfTheStrings (x : xs) = try (string x) <|> (oneOfTheStrings xs)-oneOfTheStrings [] = pzero- -{-DHUN| parses a HTML entity, that is a character escaped with the ampersand notation DHUN-}- -htmlcharp :: MyParser Char-htmlcharp- = baseParser{start =- \ _ ->- do _ <- char '&'- s <- (oneOfTheStrings [fst x | x <- htmlchars])- _ <- char ';'- return (Str (s)),- allowed = Preformat : SpaceIndent : NoWiki : everywhere,- self = HtmlChar}- -{-DHUN| parses a HTML entity, escaped with numeric ampersand notation DHUN-}- -numhtmlp :: MyParser Char-numhtmlp- = baseParser{start =- \ _ ->- do _ <- string "&#"- s <- try (many1 digit) <|>- do ss <- try (string "x") <|> try (string "X")- sss <- try (many1 hexDigit)- return $ ss ++ sss- _ <- char ';'- return (Str (s)),- allowed = Preformat : SpaceIndent : NoWiki : everywhere,- self = NumHtml}- -{-DHUN| parses a HTML #302 character. Special parser needed since it acts on the receding character DHUN-}- -p302p :: MyParser Char-p302p- = baseParser{start =- \ _ ->- do c <- anyChar- _ <- string "̂"- return (Str (c : [])),- self = P302}- -{-DHUN| parses a HTML &sub entity. DHUN-}- -subp :: MyParser Char-subp- = baseParser{start =- \ _ ->- do _ <- string "&sub"- c <- anyChar- _ <- string ";"- return (Str (c : [])),- self = Sub}- -{-DHUN| parses a HTML &sup entity. DHUN-}- -supp :: MyParser Char-supp- = baseParser{start =- \ _ ->- do _ <- string "&sup"- c <- anyChar- _ <- string ";"- return (Str (c : [])),- self = Sup}- -{-DHUN| parses the start of a new URL. That is the place where a page begin that was downloaded from an URL different from the previous one DHUN-}- -dhunurlp :: MyParser Char-dhunurlp- = baseParser{start =- \ _ ->- do _ <- string "\ndhunparserurl "- return (Str ""),- end = \ _ -> string "\n" >> return (), self = DhunUrl,- allowed = [Root, Tag]}- -{-DHUN| parses a Greek HTML entity. So a Greek letter or something similar DHUN-}- -greekp :: MyParser Char-greekp- = baseParser{start =- \ _ ->- do _ <- char '&'- s <- (oneOfTheStrings greek)- _ <- char ';'- return (Str (s)),- self = Greek}- -{-DHUN| parses the mediawiki math tag. That is a latex formula in the wiki DHUN-}- -mathp :: MyParser Char-mathp- = (maketagparser ["math"]){allowed =- SpaceIndent : everywhere ++ wikilinkwhere,- self = Math}- -{-DHUN| parses a new chapter heading DHUN-}- -chapterp :: MyParser Char-chapterp- = baseParser{start =- \ _ ->- do _ <- try- (do _ <- string "\n"- many (char ' '))- string "dhunincludechaper" >> return (Str ""),- end = \ _ -> string "/dhunincludechaper" >> return (),- self = Chapter}- -{-DHUN| parses a horizontal dividing line DHUN-}- -hdevlinep :: MyParser Char-hdevlinep- = baseParser{start =- \ _ ->- do _ <- string "----"- skipMany (string "-")- return (Str ""),- allowed = [Root], self = HDevLine}- -{-DHUN| parses the mediawiki 'nowiki' tag DHUN-}- -nowikip :: MyParser Char-nowikip- = baseParser{start = \ _ -> string "<nowiki>" >> return (Str ""),- end = \ _ -> string "</nowiki>" >> return (),- allowed = everywhere ++ wikilinkwhere ++ [SpaceIndent],- self = NoWiki}- -{-DHUN| parses the mediawiki 'noinclude' tag DHUN-}- -noincludep :: MyParser Char-noincludep- = baseParser{start =- \ _ -> string "<noinclude>" >> return (Str ""),- end =- \ _ ->- try (string "</noinclude>" >> return ()) <|>- lookAhead (eof >> return ()),- self = NoInclude}- -{-DHUN| parses the mediawiki 'includeonly' tag DHUN-}- -includep :: MyParser Char-includep- = baseParser{start =- \ _ -> string "<includeonly>" >> return (Str ""),- end = \ _ -> string "</includeonly>" >> return (),- self = IncludeOnly}- -{-DHUN| parses the mediawiki 'onlyinclude' tag DHUN-}- -includep2 :: MyParser Char-includep2- = baseParser{start =- \ _ -> string "<onlyinclude>" >> return (Str ""),- end = \ _ -> string "</onlyinclude>" >> return (),- self = IncludeOnly}- -{-DHUN| parses the mediawiki 'gallery' tag DHUN-}- -galleryp :: MyParser Char-galleryp- = baseParser{start =- \ _ ->- do _ <- string "<gallery"- skipMany (try (attr))- _ <- try (many (try (oneOf " \n"))) <|> return []- _ <- char '>'- return (Str ""),- end = \ _ -> string "</gallery>" >> return (), self = Gallery}- -{-DHUN| parses a wikilink inside a gallery DHUN-}- -gallerywlp :: MyParser Char-gallerywlp- = baseParser{bad =- \ _ ->- do _ <- lookAhead (try (string "</gallery>"))- return (),- start = \ _ -> string "\n" >> return (Str ""),- end =- \ _ ->- do _ <- lookAhead (string "\n")- return (),- modify = \ _ x -> dropWhile (== (C ' ')) x, allowed = [Gallery],- self = Wikilink}- -{-DHUN| parses the mediawiki 'imagemap' tag DHUN-}- -imagemapp :: MyParser Char-imagemapp- = baseParser{start =- \ _ ->- do _ <- string "<imagemap"- skipMany (try (attr))- _ <- try (many (try (oneOf " \n"))) <|> return []- _ <- char '>'- return (Str ""),- end = \ _ -> string "</imagemap>" >> return (), self = ImageMap}- -{-DHUN| parses a wikilink inside and imagemap DHUN-}- -imagemapwlp :: MyParser Char-imagemapwlp- = baseParser{bad =- \ _ ->- do _ <- lookAhead (try (string "</imagemap>"))- return (),- start =- \ _ ->- (do _ <- string "\n"- try (lookAhead (string "Image:")) <|>- try (lookAhead (string "File:"))- <|> (lookAhead (string "Datei:")))- >> return (Str ""),- end =- \ _ ->- do _ <- lookAhead (string "\n")- return (),- allowed = [ImageMap], self = Wikilink}- -{-DHUN| matches a sequence of arbitrary characters up to the character (an excluding it) where one of the strings given as first parameter matches DHUN-}- -myany :: [String] -> Parser String-myany x- = do b <- (try (lookAhead (oneOfTheStrings x) >> return False)) <|>- return True- if b then- do c <- anyChar- cs <- (myany x)- return (c : cs)- else return ""- -{-DHUN| parses the mediawiki template DHUN-}- -wikitemplatep :: MyParser Char-wikitemplatep- = baseParser{start =- \ _ ->- do _ <- string "{{"- s <- myany ["}}", "|"]- return (Str s),- end = \ _ -> string "}}" >> return (),- allowed =- everywhere ++- wikilinkwhere ++ [TemplateInsideVerbatim, SpaceIndent],- self = Template}- -{-DHUN| a special stack frame for parsing the inside of a template DHUN-}- -madframe :: MyStackFrame Char-madframe- = MyStackFrame{endparser =- (try (lookAhead (oneOfTheStrings ["}}", "|", "="]))) >> return (),- startdata = Str "", environment = TemplateInside,- badparser = \ _ -> pzero, parsernumber = 0, nestingdepth = 0}- -{-DHUN| parses the inside of a mediawiki template DHUN-}- -templateinsidep :: MyParser Char-templateinsidep- = baseParser{start =- \ _ ->- do _ <- string "|"- (_, bb) <- lookAhead- (try (parseAnything2 [madframe] (remake parsers) []))- if- all- (\ g ->- case g of- Open _ _ _ _ -> False- _ -> True)- bb- then- try- (do s <- myany ["|", "}}", "="]- b <- (try (string "=") >> return True) <|> return False- if b then return (Str s) else pzero)- <|> return (Str "")- else return (Str ""),- end = \ _ -> lookAhead (oneOfTheStrings ["|", "}}"]) >> return (),- allowed = [Template], self = TemplateInside}- -{-DHUN| parses the inside of a mediawiki template, it is parser verbatim that means inner structures are parsed, but returned as plain characters in the parse tree. Needed for templates use for source codes DHUN-}- -templateinsideverbatimp :: MyParser Char-templateinsideverbatimp- = baseParser{start =- \ sta ->- case sta of- (g : _) -> case (startdata g) of- Str gg -> if- (trim gg) `elem`- ["HaskellGHCiExample",- "\"HaskellGHCi\",Visual Basic .NET: Vorlage:Code",- "C++-Programmierung/ Vorlage:Syntax",- "C++-Programmierung/ Vorlage:Code",- "LaTeX/Usage", "LaTeX/LaTeX", "Latex Index"]- then- do _ <- string "|"- try- (do s <- myany ["|", "}}", "="]- b <- (try (string "=") >> return True)- <|> return False- if b then return (Str s) else pzero)- <|> return (Str "")- else pzero- _ -> pzero- [] -> pzero,- end = \ _ -> lookAhead (oneOfTheStrings ["|", "}}"]) >> return (),- allowed = [Template], self = TemplateInsideVerbatim,- reenv = const TemplateInside}- -{-DHUN| parses the inside of a template parameter DHUN-}- -wikiparamp :: MyParser Char-wikiparamp- = baseParser{start = \ _ -> string "{{{" >> return (Str ""),- end = \ _ -> string "}}}" >> return (),- allowed = everywhere ++ wikilinkwhere ++ [SpaceIndent],- self = Parameter}- -{-DHUN| parses a wikilink DHUN-}- -wikilinkp :: MyParser Char-wikilinkp- = baseParser{start = \ _ -> string "[[" >> return (Str ""),- end = \ _ -> string "]]" >> return (),- bad =- \ pchr ->- if- not $- (C '|') `elem`- (takeWhile- (\ g ->- case g of- Open _ Wikilink _ _ -> False- _ -> True)- pchr)- then- do _ <- lookAhead- ((try ((string "]") >> notFollowedBy (string "]")) <|>- (try (string "[" >> return ()))- <|> (try (string "\n") >> return ())))- return ()- else pzero,- allowed = everywhere ++ wikilinkwhere ++ [SpaceIndent],- self = Wikilink}- -{-DHUN| parses a wikilink template for wikipedia links DHUN-}- -templatewikilinkp :: MyParser Char-templatewikilinkp- = baseParser{start = \ _ -> string "{{w|" >> return (Str ""),- end = \ _ -> string "}}" >> return (),- allowed = everywhere ++ wikilinkwhere,- modify = \ _ x -> (C 'w') : (C ':') : x, self = Wikilink}- -{-DHUN| parses a link DHUN-}- -linkp :: MyParser Char-linkp- = baseParser{bad =- \ _ ->- do _ <- lookAhead (do char '\n')- return (),- start =- \ _ ->- do _ <- string "["- skipMany (char ' ')- s <- oneOfTheStrings ["http", "https", "mailto", "//"]- return (Str (if s == "//" then "http://" else s)),- end = \ _ -> string "]" >> return (), allowed = everywherel,- self = Link}- -{-DHUN| parses a link, in contrast to linkp this does not match inside links and does not require the square bracket notation DHUN-}- -linkp2 :: MyParser Char-linkp2- = baseParser{start =- \ _ ->- do s <- oneOfTheStrings ["http://", "https://"]- return (Str s),- end = \ _ -> lookAhead (oneOf " \n\r\t<>|\"") >> return (),- allowed = everywherel2, self = Link2, reenv = const Link}- -{-DHUN| parses a wikitable DHUN-}- -wikitablep :: MyParser Char-wikitablep- = baseParser{start =- \ _ ->- do _ <- char '\n'- skipMany (char ' ')- _ <- try (string "{|") <|> try (string "{{(!}}")- s <- many (noneOf "\n")- return (Str s),- end =- \ _ ->- do _ <- string "\n"- skipMany (char ' ')- _ <- try (string "|}") <|> try (string "{{!)}}")- return (),- self = Wikitable}- -{-DHUN| parses a heading, can be a chapter heading as well as a section heading and so on DHUN-}- -wikiheadingp :: MyParser Char-wikiheadingp- = baseParser{bad =- \ _ ->- lookAhead- (do _ <- string "\n"- return ()),- start =- \ _ ->- do a1 <- string "\n="- a2 <- try (string "=") <|> return ""- a3 <- try (string "=") <|> return ""- a4 <- try (string "=") <|> return ""- a5 <- try (string "=") <|> return ""- a6 <- try (string "=") <|> return ""- case (a1 ++ a2 ++ a3 ++ a4 ++ a5 ++ a6) of- (_ : xs) -> return (Str xs)- [] -> pzero,- end =- \ (Str x) ->- do _ <- string x- _ <- notFollowedBy (char '=')- return (),- self = Wikiheading, allowed = everywherel2}- -{-DHUN| parses an italic text DHUN-}- -italicp :: MyParser Char-italicp- = baseParser{start =- \ _ ->- do _ <- string "''"- return (Str "''"),- end =- \ _ ->- do (do _ <- try (string "''")- _ <- notFollowedBy (string "'")- return ())- <|> notFollowedBy (noneOf "\n")- return (),- allowed = SpaceIndent : Wikitable : Bold : everywherebi,- self = Italic}- -{-DHUN| parses a bold text DHUN-}- -boldp :: MyParser Char-boldp- = baseParser{start =- \ _ ->- do _ <- string "'''"- return (Str "'''"),- end =- \ _ ->- do (do _ <- try (string "'''")- return ())- <|> notFollowedBy (noneOf "\n")- return (),- allowed = SpaceIndent : Wikitable : Italic : everywherebi,- self = Bold}- -{-DHUN| parses a table caption DHUN-}- -tablecapp :: MyParser Char-tablecapp- = baseParser{bad =- \ _ ->- lookAhead- (try- (do _ <- string "||"- return ())- <|>- try- (do _ <- char '\n'- _ <- notFollowedBy (try (char '|') <|> (char '!'))- return ())- <|>- do _ <- string "!!"- return ()),- start =- \ _ ->- do _ <- string "\n"- skipMany (char ' ')- _ <- string "|+"- _ <- notFollowedBy (oneOf "-}")- return (Str ""),- end =- \ _ ->- lookAhead- (do _ <- char '\n'- _ <- try (char '|') <|> char '!'- notFollowedBy . char $ '}'- return ()),- allowed = [Wikitable], self = TableCap}- -{-DHUN| parses a table caption with additional parameter given to the beginning of the caption element in the wiki source DHUN-}- -tablecapp2 :: MyParser Char-tablecapp2- = baseParser{start =- \ _ ->- do _ <- string "\n"- skipMany (char ' ')- _ <- string "|+"- _ <- many (noneOf "|")- _ <- char '|'- _ <- notFollowedBy (oneOf "-}")- return (Str ""),- end =- \ _ ->- lookAhead- (try- (do _ <- char '\n'- _ <- try (char '|') <|> char '!'- notFollowedBy . char $ '}'- return ())- <|>- (try ((string "||" >> return ())) <|> (string "!!" >> return ()))),- allowed = [Wikitable], self = TableCap}- -{-DHUN| parses a table caption DHUN-}- -tablecapp3 :: MyParser Char-tablecapp3- = baseParser{start =- \ _ ->- do _ <- string "\n"- skipMany (char ' ')- _ <- string "|+"- _ <- notFollowedBy (oneOf "-}")- return (Str "2"),- allowed = [Wikitable], self = TableCap}- -{-DHUN| parses a table row separator DHUN-}- -rowsepp :: MyParser Char-rowsepp- = baseParser{start =- \ _ ->- do _ <- string "\n"- skipMany (char ' ')- _ <- try (string "|-") <|> try (string "{{!-}}")- s <- many (noneOf "\n")- return (Str s),- allowed = [Wikitable], self = TableRowSep}- -{-DHUN| parses a table column separator, with additional parameters parser to the beginning of the environment. This parser actually parses only the beginning elements and whats inside it See DHUN-}- -colsepp :: MyParser Char-colsepp- = baseParser{bad =- \ _ ->- lookAhead- (try- (do _ <- try (string "||") <|> try (string "{{!!}}")- return ())- <|>- try- (do _ <- char '\n'- return ())- <|>- do _ <- try (string "!!")- return ()),- start =- \ _ ->- try- (try- (do _ <- string "\n"- skipMany (char ' ')- _ <- try (string "|") <|> try (string "{{!}}")- _ <- notFollowedBy (oneOf "-}")- return (Str ""))- <|>- do _ <- try (string "||") <|> try (string "{{!!}}")- return (Str "")),- end =- \ _ ->- try- (do _ <- try (string "|") <|> try (string "{{!}}")- _ <- notFollowedBy (oneOf "}|")- return ()),- allowed = [Wikitable], self = TableColSep}- -{-DHUN| parses a column separator without anything inside it DHUN-}- -colsepp2 :: MyParser Char-colsepp2- = baseParser{start =- \ _ ->- try- (do _ <- string "\n"- skipMany (char ' ')- _ <- try (string "|") <|> try (string "{{!}}")- _ <- notFollowedBy (oneOf "-}")- return (Str "2"))- <|>- do _ <- try (string "||") <|> try (string "{{!!}}")- return (Str "2"),- allowed = [Wikitable], self = TableColSep}- -{-DHUN| parses a table header column separator, with additional parameters parser to the beginning of the environment. This parser actually parses only the beginning elements and whats inside it See DHUN-}- -headcolsepp :: MyParser Char-headcolsepp- = baseParser{bad =- \ _ ->- lookAhead- (try- (do _ <- try (string "||") <|> (string "{{!!}}")- return ())- <|>- try- (do _ <- char '\n'- return ())- <|>- do _ <- try (string "!!")- return ()),- start =- \ _ ->- try- (do _ <- string "\n"- skipMany (char ' ')- _ <- string "!"- _ <- notFollowedBy (oneOf "-}")- return (Str ""))- <|>- do _ <- string "!!"- return (Str ("")),- end =- \ _ ->- do _ <- try (char '|') <|> ((string "{{!}}") >> return '|')- notFollowedBy (oneOf "-}|")- return (),- allowed = [Wikitable], self = TableHeadColSep}- -{-DHUN| parses a header column separator without anything inside it DHUN-}- -headcolsepp2 :: MyParser Char-headcolsepp2- = baseParser{start =- \ _ ->- try- (do _ <- string "\n"- skipMany (char ' ')- _ <- string "!"- _ <- notFollowedBy (oneOf "-}")- return (Str ""))- <|>- do _ <- string "!!"- return (Str ""),- allowed = [Wikitable], self = TableHeadColSep}- -{-DHUN| matches a key value pair . So an attribute of an HTML element DHUN-}- -attr :: GenParser Char () ([Char], [Char])-attr- = do skipMany1 (oneOf " \n")- k <- many1 (try (alphaNum) <|> oneOf ":-")- v <- try- (do skipMany (oneOf " \n")- _ <- char '='- skipMany (oneOf " \n")- vv <- try- (do _ <- try (char '"')- vvv <- many (noneOf "\"><")- _ <- try (char '"') <|> try (noneOf "<|>") <|> return ' '- return vvv)- <|>- try- (do _ <- (char '\'')- vvv <- many (noneOf "'><")- _ <- try (char '\'') <|> try (noneOf "<|>") <|> return ' '- return vvv)- <|>- (do vvv <- many (noneOf "\"'></| ")- _ <- try (char '\'') <|> try (char '"') <|> try (noneOf "</|> ")- <|> return ' '- return vvv)- return vv)- <|> pzero- return (k, v)- -{-DHUN| Matches a key value pair. So an attribute of an HTML element DHUN-}- -attrns :: GenParser Char u ([Char], [Char])-attrns- = do k <- many1 (try (alphaNum) <|> oneOf ":-")- v <- do _ <- char '='- skipMany (oneOf " \n")- vv <- try- (do _ <- try (char '"') <|> char '\''- vvv <- many (noneOf "\"'><|")- _ <- try (char '"') <|> try (noneOf "<|>") <|> return ' '- return vvv)- <|>- (do vvvv <- (noneOf "\"'></| =")- vvv <- many (noneOf "\"'></| ")- _ <- try (char '"') <|> try (char '\'') <|> try (noneOf "</|> ")- <|> return ' '- return (vvvv : vvv))- return vv- _ <- try (many (oneOf " \n")) <|> return []- return (k, v)- -{-DHUN| Matches a list of key value pairs . So all attributes of an HTML element DHUN-}- -attrp :: MyParser Char-attrp- = baseParser{start =- \ _ ->- do atr <- try (attrns)- return (Attr atr),- allowed = [TableHeadColSep, TableColSep, TableCap],- self = Attribute}- -{-DHUN| Parses the HTML 'pre' tag DHUN-}- -prep :: MyParser Char-prep- = baseParser{start =- \ _ ->- do _ <- string "<"- p <- try (string "pre") <|> try (string "PRE") <|>- try (string "xmp")- <|> string "XMP"- atr <- many (try (attr))- _ <- try (many (oneOf " \n")) <|> return []- _ <- char '>'- return (TagAttr p (Map.fromList atr)),- end =- \ (TagAttr x _) ->- do _ <- char '<'- _ <- char '/'- _ <- string x- _ <- char '>'- return (),- allowed = everywhere, self = Preformat}- -{-DHUN| Parses the HTML 'br' tag DHUN-}- -brparser :: MyParser Char-brparser- = baseParser{start =- \ _ ->- do _ <- string "<"- _ <- try (string "/") <|> return ""- _ <- try (string "br") <|> string ("BR")- skipMany (try (attr))- _ <- try (many (oneOf " \n")) <|> return []- _ <- try (string "/") <|> return ""- _ <- try (many (oneOf " \n")) <|> return []- _ <- char '>'- return (TagAttr "br" Map.empty),- allowed = SpaceIndent : everywhere, self = Tag}- -{-DHUN| Returns a Parser that matches all HTML elements, given by the list of strings given as first input parameter. The parser does not match inside tables. Use makettagparser for that DHUN-}- -maketagparser :: [String] -> MyParser Char-maketagparser tags- = baseParser{start =- \ _ ->- do _ <- string "<"- t <- (oneOfTheStrings tags)- atr <- many (try (attr))- _ <- try (many (oneOf " \n")) <|> return []- _ <- char '>'- return (TagAttr (t) (Map.fromList atr)),- end =- \ (TagAttr x _) ->- do _ <- char '<'- _ <- try (many (oneOf " ")) <|> return []- _ <- if x `elem` nonNestTags then try (char '/') <|> (return '/')- else (char '/')- _ <- string x- _ <- char '>'- return (),- allowed = SpaceIndent : everywheretbl, self = Tag}- -{-DHUN| Parser for the 'meta' tag of HTML DHUN-}- -metatagparser :: MyParser Char-metatagparser- = baseParser{start =- \ _ ->- do _ <- string "<"- t <- (oneOfTheStrings ["meta"])- atr <- many (try (attr))- _ <- try (many (oneOf " \n")) <|> return []- _ <- try (char '/') <|> (return '/')- _ <- try (char '>') <|> (return '>')- return (TagAttr (t) (Map.fromList atr)),- allowed = SpaceIndent : everywhere, self = Tag}- -{-DHUN| Parser for the !DOCTYPE tag of HTML DHUN-}- -doctagparser :: MyParser Char-doctagparser- = baseParser{start =- \ _ ->- do _ <- string "<"- t <- (oneOfTheStrings ["!DOCTYPE"])- _ <- many (noneOf ">")- _ <- char '>'- return (TagAttr (t) (Map.fromList [])),- allowed = SpaceIndent : everywhere, self = Tag}- -{-DHUN| Parser for closing HTML tags that have not matching opening tag. DHUN-}- -ctagparser :: [String] -> GenParser Char () ()-ctagparser tags- = do _ <- string "</"- _ <- (oneOfTheStrings tags)- _ <- try (many (oneOf " \n")) <|> return []- _ <- char '>'- return ()- -{-DHUN| Returns a parser that matches all HTML elements, given by the list of strings given as first input parameter. The parser matches only the opening part of the tag. The inside of it is not processed by this parser. The opening tag may also self closing like <br/> because of the tailing /. DHUN-}- -maketagparser2 :: [String] -> MyParser Char-maketagparser2 tags- = baseParser{start =- \ _ ->- do _ <- string "<"- t <- (oneOfTheStrings tags)- atr <- many (try (attr))- _ <- try (many (oneOf " \n")) <|> return []- _ <- try (char '/') <|> (return '/')- _ <- char '>'- return (TagAttr (t) (Map.fromList atr)),- allowed = Wikitable : SpaceIndent : everywheretbl, self = Tag}- -{-DHUN| Returns a parser that matches all HTML elements, given by the list of strings given as first input parameter. The parser matches only the opening part of the tag. The inside of it is not processed by this parser. The opening tag may not be self closing so not like <br/> because of the tailing /. DHUN-}- -maketagparser3 :: [String] -> MyParser Char-maketagparser3 tags- = baseParser{start =- \ _ ->- do _ <- string "<"- t <- (oneOfTheStrings tags)- atr <- many (try (attr))- _ <- try (many (oneOf " \n")) <|> return []- _ <- char '>'- return (TagAttr (t) (Map.fromList atr)),- allowed = SpaceIndent : everywheretbl, self = Tag}- -{-DHUN| tags that can not be nested and are thus allowed to closed by an opening tag instead of a closing one DHUN-}- -nonNestTags :: [String]-nonNestTags- = ["tt", "pre", "TT", "PRE", "b", "B", "i", "I", "sc", "SC",- "code", "CODE"]- -{-DHUN| Returns a parser that matches all HTML elements, given by the list of strings given as first input parameter. The parser matches only inside tables. Use maketagparser for that DHUN-}- -makettagparser :: [String] -> MyParser Char-makettagparser tags- = baseParser{bad =- \ _ ->- do _ <- lookAhead (do try (string "\n|") <|> (string "||"))- return (),- start =- \ _ ->- do _ <- string "<"- t <- (oneOfTheStrings tags)- atr <- many (try (attr))- _ <- try (many (oneOf " \n")) <|> return []- _ <- char '>'- return (TagAttr (t) (Map.fromList atr)),- end =- \ (TagAttr x _) ->- do _ <- char '<'- _ <- try (many (oneOf " ")) <|> return []- _ <- if x `elem` nonNestTags then try (char '/') <|> (return '/')- else (char '/')- _ <- string x- _ <- char '>'- return (),- allowed = [Wikitable], self = Tag}- -{-DHUN| Returns a parser that matches all HTML elements, given by the list of strings given as first input parameter. The parser matches only the opening part of the tag. The inside of it is not processed by this parser. The opening tag may also self closing like <br/> because of the tailing /. Matches only inside tables DHUN-}- -makettagparser2 :: [String] -> MyParser Char-makettagparser2 tags- = baseParser{bad =- \ _ ->- do _ <- lookAhead- (do _ <- anyChar- try (string "\n|") <|> (string "||"))- return (),- start =- \ _ ->- do _ <- string "<"- t <- (oneOfTheStrings tags)- atr <- many (try (attr))- _ <- try (many (oneOf " \n")) <|> return []- _ <- char '/'- _ <- char '>'- return (TagAttr (t) (Map.fromList atr)),- allowed = [Wikitable], self = Tag}- -{-DHUN| maketagparser for all HTML elements see documentation on function maketagparser DHUN-}- -tagparser :: MyParser Char-tagparser = maketagparser listOfTags- -{-DHUN| maketagparser for the 'pre' HTML tag see documentation on function maketagparser DHUN-}- -tagparserp :: MyParser Char-tagparserp = maketagparser ["pre"]- -{-DHUN| maketagparser for the HTML tags for HTML tables see documentation on function maketagparser DHUN-}- -tagparsert :: MyParser Char-tagparsert- = (maketagparser listOfTableTags){self = TableTag,- reenv = const Tag}- -{-DHUN| makettagparser for all HTML elements see documentation on function makettagparser DHUN-}- -ttagparser :: MyParser Char-ttagparser = makettagparser listOfTags- -{-DHUN| makettagparser for the 'pre' HTML tag see documentation on function makettagparser DHUN-}- -ttagparserp :: MyParser Char-ttagparserp = makettagparser ["pre"]- -{-DHUN| makettagparser for the HTML tags for HTML tables see documentation on function makettagparser DHUN-}- -ttagparsert :: MyParser Char-ttagparsert- = (makettagparser listOfTableTags){self = TableTag,- reenv = const Tag}- -{-DHUN| maketagparser2 for all HTML elements see documentation on function maketagparser2 DHUN-}- -tagparser2 :: MyParser Char-tagparser2 = maketagparser2 listOfTags- -{-DHUN| maketagparser2 for the 'pre' HTML tag see documentation on function maketagparser2 DHUN-}- -tagparser2p :: MyParser Char-tagparser2p = maketagparser2 ["pre"]- -{-DHUN| maketagparser2 for the HTML tags for HTML tables see documentation on function maketagparser2 DHUN-}- -tagparser2t :: MyParser Char-tagparser2t- = (maketagparser2 listOfTableTags){self = TableTag,- reenv = const Tag}- -{-DHUN| makettagparser2 for all HTML elements see documentation on function makettagparser2 DHUN-}- -ttagparser2 :: MyParser Char-ttagparser2 = makettagparser2 listOfTags- -{-DHUN| makettagparser2 for the 'pre' HTML tag see documentation on function makettagparser2 DHUN-}- -ttagparser2p :: MyParser Char-ttagparser2p = makettagparser2 ["pre"]- -{-DHUN| makettagparser2 for the HTML tags for HTML tables see documentation on function makettagparser2 DHUN-}- -ttagparser2t :: MyParser Char-ttagparser2t- = (makettagparser2 listOfTableTags){self = TableTag,- reenv = const Tag}- -{-DHUN| a parser for mediawiki source extension tags DHUN-}- -tagparsers :: MyParser Char-tagparsers- = (maketagparser ["source", "syntaxhighlight"]){self = Source}- -{-DHUN| a parser for mediawiki source extension tags inside tables DHUN-}- -ttagparsers :: MyParser Char-ttagparsers- = (maketagparser ["source", "syntaxhighlight"]){self = Source,- allowed = [Wikitable]}- -{-DHUN| a parser for HTML tables DHUN-}- -mytablep :: MyParser Char-mytablep- = (maketagparser ["table"]){self = TableTag,- reenv = const Wikitable,- allowed = Wikitable : SpaceIndent : everywheretbl}- -{-DHUN| a parser for HTML table rows DHUN-}- -mytrsepp :: MyParser Char-mytrsepp- = (maketagparser3 ["tr"]){reenv = const TableRowSep,- allowed = everywhere}- -{-DHUN| a parser for normal HTML table cells DHUN-}- -mytcolsepp :: MyParser Char-mytcolsepp- = (maketagparser3 ["td"]){reenv = const TableColSep,- allowed = everywhere}- -{-DHUN| a parser for HTML table captions cells DHUN-}- -mytcapp :: MyParser Char-mytcapp- = (maketagparser ["caption"]){reenv = const TableCap,- allowed = everywhere}- -{-DHUN| a parser for HTML table header cells, so th tags DHUN-}- -mythcolsepp :: MyParser Char-mythcolsepp- = (maketagparser3 ["th"]){reenv = const TableHeadColSep,- allowed = everywhere}- -{-DHUN| a parser for HTML tables for html parse mode only DHUN-}- -htmytablep :: MyParser Char-htmytablep = (maketagparser ["table"])- -{-DHUN| a parser for HTML table rows for html parse mode only DHUN-}- -htmytrsepp :: MyParser Char-htmytrsepp = (maketagparser ["tr"])- -{-DHUN| a parser for normal HTML table cells for html parse mode only DHUN-}- -htmytcolsepp :: MyParser Char-htmytcolsepp = (maketagparser ["td"])- -{-DHUN| a parser for HTML table captions cells for html parse mode only DHUN-}- -htmytcapp :: MyParser Char-htmytcapp = (maketagparser ["caption"])- -{-DHUN| a parser for HTML table header cells, so th tags for html parse mode only DHUN-}- -htmythcolsepp :: MyParser Char-htmythcolsepp = (maketagparser ["th"])- -{-DHUN| a parser for closing HTML tags which don't have an opening partner. This parser is only allowed to match within itemization enumerations etc. DHUN-}- -itagparser :: MyParser Char-itagparser- = baseParser{start =- \ _ ->- do _ <- string "<"- skipMany (char '/')- t <- (oneOfTheStrings ["small"])- atr <- many (try (attr))- _ <- try (many (oneOf " \n")) <|> return []- _ <- char '>'- return (TagAttr (t) (Map.fromList atr)),- allowed = [Itemgroup], self = Tag}- -{-DHUN| a parser for closing HTML tags which don't have an opening partner DHUN-}- -rtagparser :: MyParser Char-rtagparser- = baseParser{start =- \ _ ->- do _ <- string "<"- skipMany (char '/')- _ <- (oneOfTheStrings (listOfTags ++ listOfTableTags))- atr <- many (try (attr))- _ <- try (many (oneOf " \n")) <|> return []- _ <- char '>'- return (TagAttr "bad" (Map.fromList atr)),- allowed = everywhere, self = Tag}- -{-DHUN| a parser for HTML opening tags which might be self closing but never have a matching closing partner DHUN-}- -stagparser :: MyParser Char-stagparser- = baseParser{start =- \ _ ->- do _ <- string "<"- t <- (oneOfTheStrings (listOfTags ++ listOfTableTags))- atr <- many (try (attr))- _ <- try (many (oneOf " ")) <|> return []- _ <- try (char '/') <|> return 'f'- _ <- char '>'- return (TagAttr t (Map.fromList atr)),- self = Tag, allowed = []}- -{-DHUN| a parser for HTML page breaks DHUN-}- -pagebreakp :: MyParser Char-pagebreakp- = baseParser{start =- \ _ ->- do _ <- string "<div style=\"page-break-before:always\"/>"- return (Str ""),- end = \ _ -> return (), allowed = [Root], self = PageBreak}- -{-DHUN| a parser for HTML comments DHUN-}- -commentp :: MyParser Char-commentp- = baseParser{start =- \ _ ->- do _ <- string "<!--"- return (Str ""),- allowed = everywhere ++ [Tag, TemplateInsideVerbatim],- end =- \ _ ->- do _ <- string "-->"- return (),- self = Comment}- -{-DHUN| a parser for mediawiki reserved words DHUN-}- -reservedp :: MyParser Char-reservedp- = baseParser{start =- \ _ ->- do s <- try (string "__NOTOC__") <|>- try (string "__NOEDITSECTION__")- <|> try (string "__notoc__")- <|> try (string "__TOC__")- <|> try (string "__Toc__")- <|> try (string "__INHALTSVERZEICHNIS__")- <|> try (string "__KEIN_INHALTSVERZEICHNIS__")- <|> try (string "__FORCETOC__")- <|> string " "- return (Str s),- self = Reserved, allowed = SpaceIndent : everywhere}- -{-DHUN| See documentation on evaluateItemgroup and itemParserLevelTwoDHUN-}- -itemStartString :: Anything Char -> String-itemStartString (ItemStart x) = x : []-itemStartString _ = ""- -{-DHUN| See documentation on evaluateItemgroup and itemParserLevelTwo DHUN-}- -itemStopString :: Anything Char -> String-itemStopString (ItemStop x) = x : []-itemStopString _ = ""- -{-DHUN| see documentation on evaluateItemgroup. Parser to parse the ItemStart and ItemStop elements which are essentially bracket into environments which are essentially nodes with children in the parse tree DHUN-}- -itemParserLevelTwo :: MyParser (Anything Char)-itemParserLevelTwo- = MyParser{bad = \ _ -> pzero,- start =- \ _ ->- do pos <- getPosition- z <- token show (\ _ -> pos)- (\ x -> if (itemStartString x == []) then Nothing else Just x)- return (Str (itemStartString z)),- end =- \ (Str y) ->- do pos <- getPosition- _ <- token show (\ _ -> pos)- (\ x -> if (itemStopString x == y) then Just x else Nothing)- return (),- allowed = [Root, ItemEnv], self = ItemEnv, modify = \ _ x -> x,- reenv = id}- -{-DHUN| see documentation on evaluateItemgroup. helper function to generate a list of only opening or only closing brackets, that is ItemStart or ItemStop values. The string given as first parameter states which kinds of bracket shall be opened or closed. For Openning brackets you have to call this function ItemStart as second and True as third parameter. For closing brackets you have to use ItemStop and False DHUN-}- -generateEnvironmentTagsHelper ::- String -> (Char -> Anything Char) -> Bool -> [Anything Char]-generateEnvironmentTagsHelper (c : cs) t b- = if b then- (t c) : ([Item c]) ++ (generateEnvironmentTagsHelper cs t b) else- (generateEnvironmentTagsHelper cs t b) ++ [(t c)]-generateEnvironmentTagsHelper [] _ _ = []- -{-DHUN| see documentation on evaluateItemgroup and insertEnvironmentTags. The first parameter is a string consisting of the characters #:* that is the begging of the last Itemline. The second is the same for the current ItemLine. This function return a list of ItemStart and ItemStop values for the difference between the first and the second parameter DHUN-}- -generateEnvironmentTags :: String -> String -> [Anything Char]-generateEnvironmentTags (o : os) (n : ns)- = if (o == n) then generateEnvironmentTags os ns else- (generateEnvironmentTagsHelper (o : os) ItemStop False) ++- (generateEnvironmentTagsHelper (n : ns) ItemStart True)-generateEnvironmentTags (o : os) []- = generateEnvironmentTagsHelper (o : os) ItemStop False-generateEnvironmentTags [] (n : ns)- = generateEnvironmentTagsHelper (n : ns) ItemStart True-generateEnvironmentTags [] [] = []- -{-DHUN| see documentation on evaluateItemgroup. The first parameter is a string consisting of the characters #:* that is the begging of the last Itemline. The second parameter is the content of an Itemgroup. This function returns the parse tree with the ItemStart and ItemStop values inserted DHUN-}- -insertEnvironmentTags ::- String -> [Anything Char] -> [Anything Char]-insertEnvironmentTags s ((Environment ItemLine (Str x) _) : xs)- = (generateEnvironmentTags s x) ++- ((if- (((length s) > (length x)) &&- (if length (generateEnvironmentTags s x) > 0 then- (case last (generateEnvironmentTags s x) of- Item _ -> False- _ -> True)- else True)- && (x /= ""))- || (s == x)- then [Item (last s)] else [])- ++ insertEnvironmentTags x xs)-insertEnvironmentTags s (x : xs) = x : insertEnvironmentTags s xs-insertEnvironmentTags _ [] = []- -{-DHUN| see documentation on evaluateItemgroup. Inserts the ItemStart and ItemStop values as preparation for running the second level parse on the content of an ItemGroup. The first pararmenter is a string consisting of the characters #:* that is the begging of the first Itemline. The second parameter is the content of an Itemgroup. This function returns the parse tree with the ItemStart and ItemStop values inserted DHUN-}- -toEnvironmentTags :: String -> [Anything Char] -> [Anything Char]-toEnvironmentTags s l- = insertEnvironmentTags ""- ((Environment ItemLine (Str s) []) :- l ++ [(Environment ItemLine (Str "") [])])- -{-DHUN| see documentation on evaluateItemgroup. Get the second level parse result, back to the first level parse result DHUN-}- -convertFromParsingLevelTwoToLevelOne ::- [Anything (Anything Char)] -> [Anything Char]-convertFromParsingLevelTwoToLevelOne ((C x) : xs)- = x : convertFromParsingLevelTwoToLevelOne xs-convertFromParsingLevelTwoToLevelOne ((Environment Root _ x) : xs)- = (convertFromParsingLevelTwoToLevelOne x) ++- (convertFromParsingLevelTwoToLevelOne xs)-convertFromParsingLevelTwoToLevelOne- ((Environment ItemEnv s l) : xs)- = (Environment ItemEnv s- (findMatchingBrackets3 ((convertFromParsingLevelTwoToLevelOne l))))- : convertFromParsingLevelTwoToLevelOne xs-convertFromParsingLevelTwoToLevelOne (_ : xs)- = (convertFromParsingLevelTwoToLevelOne xs)-convertFromParsingLevelTwoToLevelOne [] = []- -{-DHUN| see documentation on evaluateItemgroup. Runs the parser itemParserLevelTwo on the inner part of an ItemGroup DHUN-}- -runItemGroupPraserLevelTwo ::- GenParser (Anything Char) () [Anything (Anything Char)] ->- [Anything Char] -> [Anything (Anything Char)]-runItemGroupPraserLevelTwo p input- = case (parse p "" input) of- Left _ -> []- Right x -> x- -{-DHUN| this is for parsing itemization. It is implemented as two step process in the first step Itemgroup is created with ItemLine s in it. And ItemLine is a line starting with any combination of *#: . And Itemgroup is a sequence of lines of that kind. After this is done this function gets called with the content of an itemgroup. In the second step ItemStart and ItemStop elements are created, those are essentially the bracketed of the opening an closing part of the enumerations itemizations etc. . The function toEnvironmentTags does the insertion of the ItemStop and ItemStart values and remove the ItemLine values. parseAnything2 is run on it using the itemParserLevelTwo. This is turned into the parse tree by being passed to decon2 and put out of the parser monad by runItemGroupPraserLevelTwo. The resulting parse tree is one of type [Anything (Anything Char)] this needs to be but one level down to [Anything Char] this is done be convertFromParsingLevelTwoToLevelOne. The first parameter is a string consisting of the characters #:* that is the begging of the first Itemline. The second parameter is the content of an Itemgroup DHUN-}- -evaluateItemgroup :: String -> [Anything Char] -> [Anything Char]-evaluateItemgroup s l- = convertFromParsingLevelTwoToLevelOne- (runItemGroupPraserLevelTwo- (decon2 (remake [itemParserLevelTwo])- (parseAnything2- [MyStackFrame{endparser = pzero, startdata = Str "",- environment = Root, badparser = \ _ -> pzero, parsernumber = 0,- nestingdepth = 0}]- (remake [itemParserLevelTwo])- []))- (toEnvironmentTags s l))- -{-DHUN| a parser for a group of lines starting with one of *:;# representing in enumeration itemization etc. . This particular parser is allowed to match nearly everywhere DHUN-}- -itempgroupp :: MyParser Char-itempgroupp- = MyParser{bad = \ _ -> pzero,- start =- \ _ ->- (do _ <- string "\n"- a <- many1 (oneOf ['*', ':', ';', '#'])- return (Str a)),- end =- \ _ ->- lookAhead- (try- (do _ <- string "\n"- notFollowedBy ((oneOf ['*', ':', ';', '#'])))),- allowed = [Root, Wikitable, TemplateInside, Tag], self = Itemgroup,- modify = \ (Str x) -> evaluateItemgroup x, reenv = id}- -{-DHUN| a parser for a group of lines starting with one of *:;# representing in enumeration itemization etc. . This particular parser is only allowed to match within templates DHUN-}- -itempgrouppt :: MyParser Char-itempgrouppt- = MyParser{bad = \ _ -> pzero,- start =- \ _ ->- do _ <- string "\n"- a <- many1 (oneOf ['*', ':', ';', '#'])- return (Str a),- end =- \ _ ->- (try (lookAhead (string "}}") <|> (lookAhead (string "\n|"))) >>- return ()),- allowed = [TemplateInside], self = Itemgroup,- modify = \ (Str x) -> evaluateItemgroup x, reenv = id}- -{-DHUN| a parser for a preformat created by indenting with space DHUN-}- -presectionp :: MyParser Char-presectionp- = MyParser{bad = \ _ -> try (string "}}") >> (return ()),- start =- \ _ ->- do _ <- string "\n"- _ <- char ' '- return (Str ""),- end =- \ _ ->- lookAhead- (do _ <- string "\n"- notFollowedBy (char ' ')),- allowed = [Root, TemplateInside, Tag], self = SpaceIndent,- modify = \ _ x -> (C ' ') : x, reenv = id}- -{-DHUN| a parser for a line starting with one of *:;# representing in enumeration itemization etc. DHUN-}- -itemlinep :: MyParser Char-itemlinep- = MyParser{bad = \ _ -> pzero,- start =- \ _ ->- do _ <- string "\n"- a <- many1 (oneOf ['*', ':', ';', '#'])- return (Str a),- end = \ _ -> (return ()), allowed = [Itemgroup], self = ItemLine,- modify = \ _ x -> x, reenv = id}+{-| A parser for the medaiiwki grammar -}+module MediaWikiParser where+import Text.ParserCombinators.Parsec+import qualified Data.List as List+import qualified Data.Map as Map+import MediaWikiParseTree+import MagicStrings+import Control.Monad+import Data.String.HT (trim)+import Data.List.Split (splitOn)+import Data.List (isInfixOf)+import Tools+import Codec.Binary.UTF8.String+import Data.Maybe+import Network.URI+import WikiHelper++{-| flattens out the HTML 'a' tags. That is it replaces each 'a' element with its content. That is everything that is between its opening and its closing tag. The only parameter of this function is the parse tree to be processed. This function returns the parse tree with the 'a' HTML elements flattened |-}++reducea :: [Anything Char] -> [Anything Char]+reducea ll = concat (map go ll)+ where go :: Anything Char -> [Anything Char]+ go (Environment Tag (TagAttr "a" _) l) = l+ go (Environment x y l) = [Environment x y (reducea l)]+ go x = [x]++{-| flattens out the HTML 'div' tags, which have got a 'class' attributes present with the value 'noresize'. That is it replaces each 'div' element with the properties mentioned above by its content. That is everything that is between its opening and its closing tag. The only parameter of this function is the parse tree to be processed. This function returns the parse tree with the 'div' HTML elements with the properties given above flattened |-}++reducediv :: [Anything Char] -> [Anything Char]+reducediv ll = concat (map go ll)+ where go :: Anything Char -> [Anything Char]+ go (Environment Tag (TagAttr "div" m) l)+ | (Map.lookup "class" m) == (Just "noresize") = l+ go (Environment x y l) = [Environment x y (reducea l)]+ go x = [x]++{-| a function to get HTML elements out of a parse tree. The first parameter is name of the tag to be looked for. The second parameter is a key in the attributes of that element that has to be present for the element to be considered. The third parameter is a value that has to be found under the given key in the attributes of the element, in order for the element to be part of the returned output list. The fourth parameter is the parse tree. |-}++deepGet ::+ [Char] -> String -> [Char] -> [Anything a] -> [Anything a]+deepGet t k v ll = concat $ map go ll+ where go (Environment Tag (TagAttr tag m) l)+ | (tag == t) && ((Map.lookup k m) == (Just v)) =+ [Environment Tag (TagAttr tag m) l]+ go (Environment _ _ l) = (deepGet t k v l)+ go _ = []++{-| flattens a part of the parse tree, that is takes the characters found in the tree and turns them into a string dropping all other information in the tree -}++deepFlatten :: [Anything t] -> [Anything t]+deepFlatten ll = concat $ map go ll+ where go (Environment HtmlChar s l) = [Environment HtmlChar s l]+ go (Environment _ _ l) = (deepFlatten l)+ go x = [x]++{-| converts a wiki source document to a parse tree to be converted to LaTeX be treeToLaTeX3. The first parameter is that list of parsers. That is the list of environments to be recognized by the parser. This is usually either only plain HTML, or HTML mixed with mediawiki markup. The second parameter is the source code to be parsed. This function returns a parse tree |-}++parseit :: [MyParser Char] -> String -> [Anything Char]+parseit pp x+ = (parseit2+ (decon2 (remake pp)+ (parseAnything2+ [MyStackFrame{endparser = pzero, startdata = Str "",+ environment = Root, badparser = \ _ -> pzero, parsernumber = 0,+ nestingdepth = 0}]+ (remake pp)+ []))+ ('\n' : x))++{-| helper function of parseit, not to be called directly. This function takes the parser for the grammar, in the sense of a parser of the parsec library, (so that is the final combined parser) as first argument. It takes the source code to be parsed (usually HTML of mediawiki markup mixed with HTML) as second and runs the parser on the source code. It returns the resulting parse tree. |-}++parseit2 :: Parser [Anything Char] -> String -> [Anything Char]+parseit2 p input+ = case (parse p "" input) of+ Left _ -> []+ Right x -> x++{-| A parser for one particular element of the mediawiki grammar -}++data MyParser tok = MyParser{bad ::+ [Anything tok] -> GenParser tok () (),+ start :: MyStack tok -> GenParser tok () StartData,+ end :: StartData -> GenParser tok () (), allowed :: [EnvType],+ self :: EnvType,+ modify :: StartData -> [Anything tok] -> [Anything tok],+ reenv :: EnvType -> EnvType}++{-| the stack of the parser. See documentation on MyStackFrame in this module for details. -}++type MyStack tok = [MyStackFrame tok]++{-| A stack frame on the parsers stack. A stack frame represents an environment that was opened. So something like an opening HTML tag. The value endparser. Is a parser that should match exactly the closing bracket of the environment. The value startdata is the return value of the start parser of the enviroment. This stack frame is created immediately after the startparser of an environment has matches and is given the return value of that startparser as startdata. The value environment is the environment this stack frame belongs to in case of an HTML tag this would be Tag. See the type EnvType in the module MediaWikiParseTree for a full list of possible environments. In the parse tree that is finally generated each node with arbitrarily nested children has got an EnvType associated with it. The badparser is a parser that is repeatedly tries while processing the current environment, if it matches the current environment is considered to be invalid. Backtracking occurs an the characters currently under consideration are parser (possible very) different manner. So with badparser you can signal that an environment is invalid if a creating parser (the badparser) matches within the environment. The parserenumber is just a number that uniquely identifies each parsers in the list of parsers active for the whole parsing process. These numbers are usually generated by the remake function. The nestingdepth is a bit of a misnomer. It is a unique number for each stack frame. So each stack frame that is newly created gets a different number. -}++data MyStackFrame tok = MyStackFrame{endparser ::+ GenParser tok () (),+ startdata :: StartData, environment :: EnvType,+ badparser :: [Anything tok] -> GenParser tok () (),+ parsernumber :: Int, nestingdepth :: Int}++{-| takes a result returned by parseAnything3 and converts it into a parse tree for further processing. The only purpose of this function is to convert the notation of bracket. The bracket a denoted by the Open and Close parse tree elements of the type Anything be the function parseAnything3. The need to be converted to environments, that is node with children in the parse tree. The environments will be denoted by the 'Environment' data constructors of the type Anything|-}++decon2 ::+ (Monad m) =>+ [(a1, MyParser a)] -> m (t, [Anything a]) -> m [Anything a]+decon2 l x+ = do (_, s) <- x+ return (findMatchingBrackets l (reverse s))++{-| Usually bracket can be close in an order different from the reverse one in which they were opened. But for certain environments this is not allowed, and the order has to be strictly followed. This value is the list of those environments. -}++preserving :: [EnvType]+preserving+ = [Math, Source, Comment, Gallery, NoWiki, NoInclude, BigMath,+ Preformat, TableCap, TableRowSep, TableColSep, TableHeadColSep,+ TemplateInside, Wikitable, TableTag]++{-| Helper function for parseAnyClosingBracket. Should not be called directly. The only parameter is the current parser stack. Returns the depth on the stack of the stack frame whose closing bracket matched. -}++parseAnyClosingBracket2 ::+ (Show tok, Eq tok, Read tok) =>+ MyStack tok -> GenParser tok () Integer+parseAnyClosingBracket2+ = (parseAnyClosingBracket3 0) . (List.map (\ x -> endparser x))++{-| Helper function for parseAnyClosingBracket. Should not be called directly. The this will take stack frame by stack frame of the stack. The first parameter is an integer and indicates how many stack frames have allready been take of the stack. Returns the depth on the stack of the stack frame whose closing bracket matched. -}++parseAnyClosingBracket3 ::+ Integer -> [GenParser tok () ()] -> GenParser tok () Integer+parseAnyClosingBracket3 i (x : xs)+ = try+ (do x+ return i)+ <|> (parseAnyClosingBracket3 (i + 1) xs)+parseAnyClosingBracket3 _ [] = pzero++{-| Remove the n'th elements from a list. n is an integer an given is first parameter. The list to be processed is given as second parameter -}++myremove :: Integer -> [a] -> [a]+myremove _ [] = []+myremove 0 (_ : xs) = myremove (-1) xs+myremove i (x : xs) = x : (myremove (i - 1) xs)++{-| Enumerates a list of parsers. needed to prepare a list of parsers for use with parseAnything2 -}++remake :: [a] -> [(Int, a)]+remake x = zip (iterate (+ 1) 0) x++{-| predicate to test whether the current stack-frame-index is in a stack. The first parameter is the stack-frame-index the second parameter is the stack. Returns true if it could be found -}++isin ::+ (Show tok, Eq tok, Read tok) => Int -> (MyStack tok) -> Bool+isin i s = i `elem` (List.map nestingdepth s)++{-| tries to parse exactly one specific opening bracket. The parameters are identical to the ones of parseAnyOpeningBracket, which the exception of the second parameter. The second parameter is that parser for the bracket currently under consideration. This function 'catch' the BBad 'exception' 'thrown' by parseAnything. In this case it returns pzero, causing the parser to backtrack. -}++parseSpecificOpeningBracket ::+ (Show tok, Eq tok, Read tok) =>+ Int ->+ (Int, MyParser tok) ->+ (MyStack tok) ->+ [(Int, MyParser tok)] ->+ [Anything tok] ->+ GenParser tok () (Either2 (MyStack tok, [Anything tok]))+parseSpecificOpeningBracket v (n, x) s l i+ = do r <- do sd <- try (start x s)+ parseAnything (v + 1)+ (MyStackFrame{endparser = (end x) sd, startdata = sd,+ environment = self x, badparser = bad x, parsernumber = n,+ nestingdepth = v}+ : s)+ l+ ((Open (length s) (self x) sd n) : i)+ case r of+ BBad (ss, y) -> if isin v ss then pzero else return (BBad (ss, y))+ _ -> return r++{-| tried to parse any of the opening brackets given by the parsers passed as the third parameter. The first parameter is the stack number (see documentation of the parseAnything function for more details on that). The second parameter is the current parser stack (see documentation of the parseAnything2 function for more details on that). The forth parameter is the list of parsers to b taken into account by the general parsing process. In contrast the third parameter contains only a list of parsers that are allowed to match in the current step of the parsing process. The fifth parameter is the current parser output stream. That is the information returned by the parser up to the current step. It is kind of an accumulator for parser results. -}++parseAnyOpeningBracket ::+ (Show tok, Eq tok, Read tok) =>+ Int ->+ MyStack tok ->+ [(Int, MyParser tok)] ->+ [(Int, MyParser tok)] ->+ [Anything tok] ->+ GenParser tok () (Either2 (MyStack tok, [Anything tok]))+parseAnyOpeningBracket _ _ [] _ _ = pzero+parseAnyOpeningBracket v s (x : xs) l i+ = try (parseSpecificOpeningBracket v x s l i) <|>+ parseAnyOpeningBracket v s xs l i++{-| insert a list of closing brackets into the parser output stream. Later on matching opening and closing brackets will be found and parse tree will be generated this way. The first parameter is an integer it is the number of brackets which should be close. The second parameter is the parser stack. It says which kind of brackets should be closed. It returns a parser output stream just containing the opening brackets -}++generateClosingBrackets ::+ (Num a, Eq a, Show tok, Eq tok, Read tok) =>+ a -> MyStack tok -> [Anything tok]+generateClosingBrackets 0 (s : xs)+ = [Close (length xs) (environment s)]+generateClosingBrackets mi (s : xs)+ = (Close (length xs) (environment s)) :+ (generateClosingBrackets (mi - 1) xs)+generateClosingBrackets _ _ = []++{-| insert a list of opening brackets into the parser output stream. Later on matching opening and closing brackets will be found and parse tree will be generated this way. The first parameter is an integer it is the number of brackets which should be opened. The second parameter is the parser stack. It says which kind of brackets should be opened. It returns a parser output stream just containing the opening brackets -}++generateOpeningBrackets ::+ (Num a, Eq a, Show tok, Eq tok, Read tok) =>+ a -> MyStack tok -> [Anything tok]+generateOpeningBrackets 0 _ = []+generateOpeningBrackets mi (s : xs)+ = (Open (length xs) (environment s) (startdata s) (parsernumber s))+ : (generateOpeningBrackets (mi - 1) xs)+generateOpeningBrackets _ _ = []++{-| a version of either with the difference that the left and right types are the same. RRight stands for sucessful parse of a token. BBad stands for parse failure in which the next possiblity is tried. -}++data Either2 b = RRight b+ | BBad b++{-| tries to match any of the currently possible closing brackets. Brackets closed in a order different from the reverse to the one in which they were opened are usually possible. And exception are the so called preserving elements, they can only be closed in the correct order. In the general case of this kind of crossbracketing it is necessary to add some opening and closing brackets to the output stream and to take the right stack frame of the stack keeping all others on it in the right order. -}++parseAnyClosingBracket ::+ (Show tok, Eq tok, Read tok) =>+ Int ->+ MyStack tok ->+ [(Int, MyParser tok)] ->+ [Anything tok] ->+ GenParser tok () (Either2 (MyStack tok, [Anything tok]))+parseAnyClosingBracket v s l i+ = do mi <- try+ (do mmi <- parseAnyClosingBracket2 s+ guard+ (case s of+ (g : _) -> (mmi == 0) ||+ ((environment g) == Link2) ||+ ((not ((environment g) `elem` preserving)) &&+ (not+ ((environment (s !! (fromIntegral mmi))) `elem`+ preserving)))+ [] -> False)+ return mmi)+ let ss = myremove mi s+ parseAnything v ss l+ ((reverse+ ((generateClosingBrackets mi s) +++ (reverse (generateOpeningBrackets mi ss))))+ ++ i)++{-| this function tries to match the bad parser of the current environment. If it matches it returns BBAD, otherwise it returns RRight. See also comment of the parserAnything function. -}++trybadparser ::+ (Show tok, Eq tok, Read tok) =>+ MyStack tok ->+ [Anything tok] -> GenParser tok () (Either2 (MyStack tok, [a2]))+trybadparser s i+ = do x <- case s of+ (g : _) -> (do _ <- (badparser g) i+ return True)+ <|> return False+ [] -> return False+ if x == True then return (BBad (s, [])) else+ return (RRight (s, []))++{-| this is the main function of the parser which calls itself recursively. To run the parser you should not call this function directly but rather use parseAnything2. The parameter are the same as the parameters to the parameters to the function parseAnything2. So look at the documentation for their meaning. But there is one additional parameter namely the first one. This is the stack frame number, it is increase for every stack frame and never decreased this way each stack frame has got a unique identifier this way. An other difference is the return type this function returns the always same type as the function parseAnything2, but wrapped in the Either2 monad. The Either2 monad has an additional bit to signal whether the parse was good or bad. The bad bit signals so called bad parser of the current environment has matched signaling that the environment is to be considered invalid, and we have to backtrack. But what we do here is just stop paring and return a successful parse, but return the bad flag as set in the return type. This will propagate through to the parser that was trying to open the environment that caused the current problem. If that recognizes the problem it can flag the environment as failed by returning pzero. So again here we just return BBad. So we kind of throw an exception. And in parseSpecificOpeningBracket we will catch BBad and signal the actual problem by returning pzero and that way kick of backtracking. -}++parseAnything ::+ (Show tok, Eq tok, Read tok) =>+ Int ->+ MyStack tok ->+ [(Int, MyParser tok)] ->+ [Anything tok] ->+ GenParser tok () (Either2 (MyStack tok, [Anything tok]))+parseAnything v s l i+ = (do eof+ return $ RRight (s, i ++ (generateClosingBrackets (length s) s)))+ <|>+ do nb <- trybadparser s i+ case nb of+ RRight _ -> try (parseAnyClosingBracket v s l i) <|>+ case s of+ (g : _) -> do try+ (parseAnyOpeningBracket v s+ [x | x <- l,+ (environment g) `elem` (allowed (snd x))]+ l+ i)+ [] -> return (RRight ([], i))+ <|>+ do c <- anyToken+ parseAnything v s l ((C c) : i)+ BBad _ -> case s of+ (g : _) -> try+ (parseAnyOpeningBracket v s+ [x | x <- l, (environment g) `elem` (allowed (snd x))]+ l+ i)+ <|> return (BBad (s, i))+ [] -> pzero++{-| This is the main entry point of the parse. So the function you need to call when you want to convert the source into the parse tree. The first parameter is the stack. I usually should contain only and exactly the root stack frame. The second parameter is an enumerated list of parsers. You usually take a list like the list parsers from this module and enumerate it by running remake on it. So thats the list of environments the parser is able to recognize. The third parameter is the parse results that have been created so far. Since we are just starting the parse this has to be the empty list. The function returns a parser. See the documentation of the parse module for more details on the type GenParser. Roughly is means that this parser takes an input list whose items are of type tok and that the parsers does not have state (hence the void type '()') and return a tuple. The first elements of that tuple is a stack. Where a new stack frame is added to the stack for each new environment that is found to open by the parser, like an opening HTML tag. And the second elements of the tuple is a parse tree, that is a list of parse tree elements, where each parse tree element may contain sublists of parse tree element. This way it is a real tree. -}++parseAnything2 ::+ (Show tok, Eq tok, Read tok) =>+ MyStack tok ->+ [(Int, MyParser tok)] ->+ [Anything tok] -> GenParser tok () (MyStack tok, [Anything tok])+parseAnything2 s l i+ = do x <- parseAnything 0 s l i+ case x of+ BBad (_, b) -> return (s, b)+ RRight b -> return b++{-| this find the matching closing bracket for an opening bracket. It returns a tuple. Its first element is the environment created form the given opening bracket together with its closing bracket and the content between opening and closing bracket. Its second elements is the remaining list of parsed elements, after the closing bracket. This list does still contain the Open and Close parser tree elements for opening and closing bracket, and those are not yet converted to environments. This function takes the list of parse tree elements after the opening bracket as first input parameter. It takes the index of the parser that created the opening bracket as second input parameter. That is the index created by the remake function in this module. It takes the size of the stack at the time when the opening bracket was found as third input parameter. It takes the EnvType of the environment of the opening bracket as fourth input parameter. It takes the StartData parse result associated with the opening bracket as fifth parameter. The sixth parameter is the accumulator an should be the empty list when calling this function externally. The seventh parameter is the remaining parse tree after the opening bracket without the opening and closing brackets converted to environments -}++findMatchingClosingBracket ::+ [(a1, MyParser a)] ->+ Int ->+ Int ->+ EnvType ->+ StartData ->+ [Anything a] -> [Anything a] -> (Anything a, [Anything a])+findMatchingClosingBracket l n i e s b ((Close i2 e2) : xs)+ = if (i, e) == (i2, e2) then+ (Environment ((reenv (snd (l !! n))) e) s+ ((modify (snd (l !! n))) s (findMatchingBrackets l (reverse b))),+ xs)+ else findMatchingClosingBracket l n i e s ((Close i2 e2) : b) xs+findMatchingClosingBracket l n i e s b (x : xs)+ = findMatchingClosingBracket l n i e s (x : b) xs+findMatchingClosingBracket l n _ e s b []+ = (Environment ((reenv (snd (l !! n))) e) s+ ((modify (snd (l !! n))) s (findMatchingBrackets l (reverse b))),+ [])++{-| run findMatchingBrackets on the inner part environment given as second parameter. This function takes the enumerated list of parsers created by remake as first input parameter -}++findMatchingBrackets2 ::+ [(a1, MyParser a)] -> Anything a -> Anything a+findMatchingBrackets2 l (Environment e s b)+ = Environment e s (findMatchingBrackets l b)+findMatchingBrackets2 l xs+ = Environment Root (Str "") (findMatchingBrackets l [xs])++{-| the parser (Anything3) creates a list of parser elements, which is not a tree. The environments which will form the nodes with children in the final tree are denoted as opening and closing brackets in this list. This function takes that list as second input parameter, finds matching pairs of opening and closing brackets and converts the to environments. The opening an closing brackets are already balanced because of the way Anything3 works, that means there is exactly one matching closing bracket for each opening one and they open and close in to proper order. This function takes the enumerated list of parsers as first input parameter, that is the same list also given to the function Anything. -}++findMatchingBrackets ::+ [(a1, MyParser a)] -> [Anything a] -> [Anything a]+findMatchingBrackets l ((Open i e s n) : xs)+ = let (t, xxs) = findMatchingClosingBracket l n i e s [] xs in+ (findMatchingBrackets2 l t) : (findMatchingBrackets l xxs)+findMatchingBrackets l (x : xs) = x : (findMatchingBrackets l xs)+findMatchingBrackets _ [] = []++{-| a list of environments. Most parsers use this list as their 'allowed' variable. Meaning that the parser is only allowed to match within the environments given in the 'allowed' list -}++everywhere :: [EnvType]+everywhere = [Wikitable] ++ everywheretbl++{-| list containing the Italic and Bold environments, see documentation on the list 'everywhere' in this module -}++bi :: [EnvType]+bi = [Italic, Bold]++{-| list containing the same environments as the list 'everywhere' except the Wikitable environment, see documentation on the list 'everywhere' in this module -}++everywheretbl :: [EnvType]+everywheretbl = bi ++ everywherebi++{-| list containing the same environments as the list 'everywhere' except the environment Wikitable, Bold and Italic, see documentation on the list 'everywhere' in this module -}++everywherebi :: [EnvType]+everywherebi = basicwhere ++ [Wikilink]++{-| list containing the same environments as the list 'everywhere' except the environment Wikitable, Bold, Italic and Wikilink see documentation on the list 'everywhere' in this module -}++basicwhere :: [EnvType]+basicwhere = [Link] ++ verybasicwhere++{-| list containing the same environments as the list 'everywhere' except the environment Wikitable, Bold, Italic, Wikilink and Link see documentation on the list 'everywhere' in this module -}++verybasicwhere :: [EnvType]+verybasicwhere+ = [Itemgroup, Root, Wikiheading, TableCap, Chapter, Tag, TableTag,+ TemplateInside, IncludeOnly]++{-| list containing the environments where the parser linkp is allowed to match. Currently this seems to be everywhere. So this possibly can go away -}++everywherel :: [EnvType]+everywherel = basicwhere ++ bi ++ [Wikitable, Wikilink]++{-| list containing the same environments as the list 'everywhere' except the Link environment see documentation on the list 'everywhere' in this module -}++everywherel2 :: [EnvType]+everywherel2 = verybasicwhere ++ bi ++ [Wikitable, Wikilink]++{-| list containing the TableColSep and TableHeadColSep environments, see documentation on the list 'everywhere' in this module. the environments mean table header column separator and table column separator -}++wikilinkwhere :: [EnvType]+wikilinkwhere = [TableColSep, TableHeadColSep]++{-| the list of parsers needed for processing the HTML output created by MediaWiki -}++minparsers :: [MyParser Char]+minparsers+ = [doctagparser, metatagparser, supp, subp, dhunurlp, itagparser,+ pagebreakp, htmlcharp, p302p, attrp, greekp, brparser, mytablep,+ mytrsepp, mytcolsepp, mytcapp, mythcolsepp, annop, tagparser,+ tagparserp, tagparser2, tagparser2p, tagparsert, tagparsert,+ tagparser2t, tagparsers, stagparser, commentp, numhtmlp,+ rtagparser]++{-| the list of parsers for parsing contributor information for images on MediaWiki websites -}++htmlminparsers :: [MyParser Char]+htmlminparsers+ = [doctagparser, metatagparser, supp, subp, dhunurlp, itagparser,+ pagebreakp, htmlcharp, p302p, attrp, greekp, brparser, htmytablep,+ htmytrsepp, htmytcolsepp, htmytcapp, htmythcolsepp, tagparser,+ tagparserp, tagparser2, tagparser2p, tagparsert, tagparsert,+ tagparser2t, tagparsers, stagparser, commentp, numhtmlp,+ rtagparser]++{-| the list of parsers needed for processing the image title description so that is the content a html attibutes -}++imgparsers :: [MyParser Char]+imgparsers = [supp, subp, htmlcharp, p302p, greekp, numhtmlp]++{-| the list of parsers needed for parsing source code in the MediaWiki markup language -}++parsers :: [MyParser Char]+parsers+ = [doctagparser, metatagparser, supp, subp, dhunurlp, itagparser,+ chapterp, prep, pagebreakp, htmlcharp, p302p, attrp, greekp,+ brparser, wikilinkp, wikitablep, mytablep, wikiheadingp,+ itempgrouppt, itempgroupp, itemlinep, boldp, italicp, tablecapp,+ tablecapp2, tablecapp3, rowsepp, mytrsepp, colsepp, colsepp2,+ mytcolsepp, mytcapp, headcolsepp, headcolsepp2, mythcolsepp,+ galleryp, imagemapp, nowikip, noincludep, mathp, annop, imagemapp,+ ttagparser, ttagparser2, ttagparsert, ttagparser2t, ttagparsers,+ tagparser, tagparser2, tagparsert, tagparser2t, tagparsers,+ stagparser, commentp, reservedp, templatewikilinkp, wikiparamp,+ wikitemplatep, templateinsideverbatimp, templateinsidep,+ gallerywlp, imagemapwlp, hdevlinep, linkp, linkp2, presectionp,+ presectionpt, numhtmlp, rtagparser]++{-| the parser record, with some fields initialized with default values -}++baseParser :: MyParser tok+baseParser+ = MyParser{bad = \ _ -> pzero, start = undefined,+ end = \ _ -> return (), allowed = everywhere, self = undefined,+ modify = \ _ x -> x, reenv = id}++{-| this function takes a string and returns a parser that matches any of the given strings -}++oneOfTheStrings :: [String] -> Parser String+oneOfTheStrings (x : xs) = try (string x) <|> (oneOfTheStrings xs)+oneOfTheStrings [] = pzero++{-| parses a HTML entity, that is a character escaped with the ampersand notation -}++htmlcharp :: MyParser Char+htmlcharp+ = baseParser{start =+ \ _ ->+ do _ <- char '&'+ s <- (oneOfTheStrings [fst x | x <- htmlchars])+ _ <- char ';'+ return (Str (s)),+ allowed = Preformat : SpaceIndent : NoWiki : everywhere,+ self = HtmlChar}++{-| parses a HTML entity, escaped with numeric ampersand notation -}++numhtmlp :: MyParser Char+numhtmlp+ = baseParser{start =+ \ _ ->+ do _ <- string "&#"+ s <- try (many1 digit) <|>+ do ss <- try (string "x") <|> try (string "X")+ sss <- try (many1 hexDigit)+ return $ ss ++ sss+ _ <- char ';'+ return (Str (s)),+ allowed = Preformat : SpaceIndent : NoWiki : everywhere,+ self = NumHtml}++{-| parses a HTML #302 character. Special parser needed since it acts on the receding character -}++p302p :: MyParser Char+p302p+ = baseParser{start =+ \ _ ->+ do c <- anyChar+ _ <- string "̂"+ return (Str (c : [])),+ self = P302}++{-| parses a HTML &sub entity. -}++subp :: MyParser Char+subp+ = baseParser{start =+ \ _ ->+ do _ <- string "&sub"+ c <- anyChar+ _ <- string ";"+ return (Str (c : [])),+ self = Sub}++{-| parses a HTML &sup entity. -}++supp :: MyParser Char+supp+ = baseParser{start =+ \ _ ->+ do _ <- string "&sup"+ c <- anyChar+ _ <- string ";"+ return (Str (c : [])),+ self = Sup}++{-| parses the start of a new URL. That is the place where a page begin that was downloaded from an URL different from the previous one -}++dhunurlp :: MyParser Char+dhunurlp+ = baseParser{start =+ \ _ ->+ do _ <- string "\ndhunparserurl "+ return (Str ""),+ end = \ _ -> string "\n" >> return (), self = DhunUrl,+ allowed = [Root, Tag]}++{-| parses a Greek HTML entity. So a Greek letter or something similar -}++greekp :: MyParser Char+greekp+ = baseParser{start =+ \ _ ->+ do _ <- char '&'+ s <- (oneOfTheStrings greek)+ _ <- char ';'+ return (Str (s)),+ self = Greek}++{-| parses the mediawiki math tag. That is a latex formula in the wiki -}++mathp :: MyParser Char+mathp+ = (maketagparser ["math"]){allowed =+ SpaceIndent : everywhere ++ wikilinkwhere,+ self = Math}++annop :: MyParser Char+annop+ = (maketagparser ["annotation"]){allowed =+ SpaceIndent : everywhere ++ wikilinkwhere,+ self = Math, reenv = const Tag}++{-| parses a new chapter heading -}++chapterp :: MyParser Char+chapterp+ = baseParser{start =+ \ _ ->+ do _ <- try+ (do _ <- string "\n"+ many (char ' '))+ string "dhunincludechaper" >> return (Str ""),+ end = \ _ -> string "/dhunincludechaper" >> return (),+ self = Chapter}++{-| parses a horizontal dividing line -}++hdevlinep :: MyParser Char+hdevlinep+ = baseParser{start =+ \ _ ->+ do _ <- string "----"+ skipMany (string "-")+ return (Str ""),+ allowed = [Root], self = HDevLine}++{-| parses the mediawiki 'nowiki' tag -}++nowikip :: MyParser Char+nowikip+ = baseParser{start = \ _ -> string "<nowiki>" >> return (Str ""),+ end = \ _ -> string "</nowiki>" >> return (),+ allowed = everywhere ++ wikilinkwhere ++ [SpaceIndent],+ self = NoWiki}++{-| parses the mediawiki 'noinclude' tag -}++noincludep :: MyParser Char+noincludep+ = baseParser{start =+ \ _ -> string "<noinclude>" >> return (Str ""),+ end =+ \ _ ->+ try (string "</noinclude>" >> return ()) <|>+ lookAhead (eof >> return ()),+ self = NoInclude}++{-| parses the mediawiki 'includeonly' tag -}++includep :: MyParser Char+includep+ = baseParser{start =+ \ _ -> string "<includeonly>" >> return (Str ""),+ end = \ _ -> string "</includeonly>" >> return (),+ self = IncludeOnly}++{-| parses the mediawiki 'onlyinclude' tag -}++includep2 :: MyParser Char+includep2+ = baseParser{start =+ \ _ -> string "<onlyinclude>" >> return (Str ""),+ end = \ _ -> string "</onlyinclude>" >> return (),+ self = IncludeOnly}++{-| parses the mediawiki 'gallery' tag -}++galleryp :: MyParser Char+galleryp+ = baseParser{start =+ \ _ ->+ do _ <- string "<gallery"+ skipMany (try (attr))+ _ <- try (many (try (oneOf " \n"))) <|> return []+ _ <- char '>'+ return (Str ""),+ end = \ _ -> string "</gallery>" >> return (), self = Gallery}++{-| parses a wikilink inside a gallery -}++gallerywlp :: MyParser Char+gallerywlp+ = baseParser{bad =+ \ _ ->+ do _ <- lookAhead (try (string "</gallery>"))+ return (),+ start = \ _ -> string "\n" >> return (Str ""),+ end =+ \ _ ->+ do _ <- lookAhead (string "\n")+ return (),+ modify = \ _ x -> dropWhile (== (C ' ')) x, allowed = [Gallery],+ self = Wikilink}++{-| parses the mediawiki 'imagemap' tag -}++imagemapp :: MyParser Char+imagemapp+ = baseParser{start =+ \ _ ->+ do _ <- string "<imagemap"+ skipMany (try (attr))+ _ <- try (many (try (oneOf " \n"))) <|> return []+ _ <- char '>'+ return (Str ""),+ end = \ _ -> string "</imagemap>" >> return (), self = ImageMap}++{-| parses a wikilink inside and imagemap -}++imagemapwlp :: MyParser Char+imagemapwlp+ = baseParser{bad =+ \ _ ->+ do _ <- lookAhead (try (string "</imagemap>"))+ return (),+ start =+ \ _ ->+ (do _ <- string "\n"+ try (lookAhead (string "Image:")) <|>+ try (lookAhead (string "File:"))+ <|> (lookAhead (string "Datei:")))+ >> return (Str ""),+ end =+ \ _ ->+ do _ <- lookAhead (string "\n")+ return (),+ allowed = [ImageMap], self = Wikilink}++{-| matches a sequence of arbitrary characters up to the character (an excluding it) where one of the strings given as first parameter matches -}++myany :: [String] -> Parser String+myany x+ = do b <- (try (lookAhead (oneOfTheStrings x) >> return False)) <|>+ return True+ if b then+ do c <- anyChar+ cs <- (myany x)+ return (c : cs)+ else return ""++{-| parses the mediawiki template -}++wikitemplatep :: MyParser Char+wikitemplatep+ = baseParser{start =+ \ _ ->+ do _ <- string "{{"+ s <- myany ["}}", "|"]+ return (Str s),+ end = \ _ -> string "}}" >> return (),+ allowed =+ everywhere +++ wikilinkwhere ++ [TemplateInsideVerbatim, SpaceIndent],+ self = Template}++{-| a special stack frame for parsing the inside of a template -}++madframe :: MyStackFrame Char+madframe+ = MyStackFrame{endparser =+ (try (lookAhead (oneOfTheStrings ["}}", "|", "="]))) >> return (),+ startdata = Str "", environment = TemplateInside,+ badparser = \ _ -> pzero, parsernumber = 0, nestingdepth = 0}++{-| parses the inside of a mediawiki template -}++templateinsidep :: MyParser Char+templateinsidep+ = baseParser{start =+ \ _ ->+ do _ <- string "|"+ (_, bb) <- lookAhead+ (try (parseAnything2 [madframe] (remake parsers) []))+ if+ all+ (\ g ->+ case g of+ Open _ _ _ _ -> False+ _ -> True)+ bb+ then+ try+ (do s <- myany ["|", "}}", "="]+ b <- (try (string "=") >> return True) <|> return False+ if b then return (Str s) else pzero)+ <|> return (Str "")+ else return (Str ""),+ end = \ _ -> lookAhead (oneOfTheStrings ["|", "}}"]) >> return (),+ allowed = [Template], self = TemplateInside}++{-| parses the inside of a mediawiki template, it is parser verbatim that means inner structures are parsed, but returned as plain characters in the parse tree. Needed for templates use for source codes -}++templateinsideverbatimp :: MyParser Char+templateinsideverbatimp+ = baseParser{start =+ \ sta ->+ case sta of+ (g : _) -> case (startdata g) of+ Str gg -> if+ (trim gg) `elem`+ ["HaskellGHCiExample",+ "\"HaskellGHCi\",Visual Basic .NET: Vorlage:Code",+ "C++-Programmierung/ Vorlage:Syntax", "syntax",+ "Syntax", "C++-Programmierung/ Vorlage:Code",+ "BigJava", "LaTeX/Usage", "LaTeX/LaTeX",+ "Latex Index"]+ then+ do _ <- string "|"+ try+ (do s <- myany ["|", "}}", "="]+ b <- (try (string "=") >> return True)+ <|> return False+ if b then return (Str s) else pzero)+ <|> return (Str "")+ else pzero+ _ -> pzero+ [] -> pzero,+ end = \ _ -> lookAhead (oneOfTheStrings ["|", "}}"]) >> return (),+ allowed = [Template], self = TemplateInsideVerbatim,+ reenv = const TemplateInside}++{-| parses the inside of a template parameter -}++wikiparamp :: MyParser Char+wikiparamp+ = baseParser{start = \ _ -> string "{{{" >> return (Str ""),+ end = \ _ -> string "}}}" >> return (),+ allowed = everywhere ++ wikilinkwhere ++ [SpaceIndent],+ self = Parameter}++{-| parses a wikilink -}++wikilinkp :: MyParser Char+wikilinkp+ = baseParser{start = \ _ -> string "[[" >> return (Str ""),+ end = \ _ -> string "]]" >> return (),+ bad =+ \ pchr ->+ if+ not $+ (C '|') `elem`+ (takeWhile+ (\ g ->+ case g of+ Open _ Wikilink _ _ -> False+ _ -> True)+ pchr)+ then+ do _ <- lookAhead+ ((try ((string "]") >> notFollowedBy (string "]")) <|>+ (try (string "[" >> return ()))+ <|> (try (string "\n") >> return ())))+ return ()+ else pzero,+ allowed = everywhere ++ wikilinkwhere ++ [SpaceIndent],+ self = Wikilink}++{-| parses a wikilink template for wikipedia links -}++templatewikilinkp :: MyParser Char+templatewikilinkp+ = baseParser{start = \ _ -> string "{{w|" >> return (Str ""),+ end = \ _ -> string "}}" >> return (),+ allowed = everywhere ++ wikilinkwhere,+ modify = \ _ x -> (C 'w') : (C ':') : x, self = Wikilink}++{-| parses a link -}++linkp :: MyParser Char+linkp+ = baseParser{bad =+ \ _ ->+ do _ <- lookAhead (do char '\n')+ return (),+ start =+ \ _ ->+ do _ <- string "["+ skipMany (char ' ')+ s <- oneOfTheStrings ["http", "https", "mailto", "//"]+ return (Str (if s == "//" then "http://" else s)),+ end = \ _ -> string "]" >> return (), allowed = everywherel,+ self = Link}++{-| parses a link, in contrast to linkp this does not match inside links and does not require the square bracket notation -}++linkp2 :: MyParser Char+linkp2+ = baseParser{start =+ \ _ ->+ do s <- oneOfTheStrings ["http://", "https://"]+ return (Str s),+ end = \ _ -> lookAhead (oneOf " \n\r\t<>|\"") >> return (),+ allowed = everywherel2, self = Link2, reenv = const Link}++{-| parses a wikitable -}++wikitablep :: MyParser Char+wikitablep+ = baseParser{start =+ \ _ ->+ do _ <- try (char '\n') <|> return '\n'+ skipMany (char ' ')+ _ <- try (string "{|") <|> try (string "{{(!}}")+ s <- many (noneOf "\n")+ return (Str s),+ end =+ \ _ ->+ do _ <- string "\n"+ skipMany (char ' ')+ _ <- try (string "|}") <|> try (string "{{!)}}")+ return (),+ self = Wikitable}++{-| parses a heading, can be a chapter heading as well as a section heading and so on -}++wikiheadingp :: MyParser Char+wikiheadingp+ = baseParser{bad =+ \ _ ->+ lookAhead+ (do _ <- string "\n"+ return ()),+ start =+ \ _ ->+ do a1 <- string "\n="+ a2 <- try (string "=") <|> return ""+ a3 <- try (string "=") <|> return ""+ a4 <- try (string "=") <|> return ""+ a5 <- try (string "=") <|> return ""+ a6 <- try (string "=") <|> return ""+ case (a1 ++ a2 ++ a3 ++ a4 ++ a5 ++ a6) of+ (_ : xs) -> return (Str xs)+ [] -> pzero,+ end =+ \ (Str x) ->+ do _ <- string x+ _ <- notFollowedBy (char '=')+ return (),+ self = Wikiheading, allowed = everywherel2}++{-| parses an italic text -}++italicp :: MyParser Char+italicp+ = baseParser{start =+ \ _ ->+ do _ <- string "''"+ return (Str "''"),+ end =+ \ _ ->+ do (do _ <- try (string "''")+ _ <- notFollowedBy (string "'")+ return ())+ <|> notFollowedBy (noneOf "\n")+ return (),+ allowed = SpaceIndent : Wikitable : Bold : everywherebi,+ self = Italic}++{-| parses a bold text -}++boldp :: MyParser Char+boldp+ = baseParser{start =+ \ _ ->+ do _ <- string "'''"+ return (Str "'''"),+ end =+ \ _ ->+ do (do _ <- try (string "'''")+ return ())+ <|> notFollowedBy (noneOf "\n")+ return (),+ allowed = SpaceIndent : Wikitable : Italic : everywherebi,+ self = Bold}++{-| parses a table caption -}++tablecapp :: MyParser Char+tablecapp+ = baseParser{bad =+ \ _ ->+ lookAhead+ (try+ (do _ <- string "||"+ return ())+ <|>+ try+ (do _ <- char '\n'+ _ <- notFollowedBy (try (char '|') <|> (char '!'))+ return ())+ <|>+ do _ <- string "!!"+ return ()),+ start =+ \ _ ->+ do _ <- string "\n"+ skipMany (char ' ')+ _ <- string "|+"+ _ <- notFollowedBy (oneOf "-}")+ return (Str ""),+ end =+ \ _ ->+ lookAhead+ (do _ <- char '\n'+ _ <- try (char '|') <|> char '!'+ notFollowedBy . char $ '}'+ return ()),+ allowed = [Wikitable], self = TableCap}++{-| parses a table caption with additional parameter given to the beginning of the caption element in the wiki source -}++tablecapp2 :: MyParser Char+tablecapp2+ = baseParser{start =+ \ _ ->+ do _ <- string "\n"+ skipMany (char ' ')+ _ <- string "|+"+ _ <- many (noneOf "|")+ _ <- char '|'+ _ <- notFollowedBy (oneOf "-}")+ return (Str ""),+ end =+ \ _ ->+ lookAhead+ (try+ (do _ <- char '\n'+ _ <- try (char '|') <|> char '!'+ notFollowedBy . char $ '}'+ return ())+ <|>+ (try ((string "||" >> return ())) <|> (string "!!" >> return ()))),+ allowed = [Wikitable], self = TableCap}++{-| parses a table caption -}++tablecapp3 :: MyParser Char+tablecapp3+ = baseParser{start =+ \ _ ->+ do _ <- string "\n"+ skipMany (char ' ')+ _ <- string "|+"+ _ <- notFollowedBy (oneOf "-}")+ return (Str "2"),+ allowed = [Wikitable], self = TableCap}++{-| parses a table row separator -}++rowsepp :: MyParser Char+rowsepp+ = baseParser{start =+ \ _ ->+ do _ <- string "\n"+ skipMany (char ' ')+ _ <- try (string "|-") <|> try (string "{{!-}}")+ s <- many (noneOf "\n")+ return (Str s),+ allowed = [Wikitable], self = TableRowSep}++{-| parses a table column separator, with additional parameters parser to the beginning of the environment. This parser actually parses only the beginning elements and whats inside it See -}++colsepp :: MyParser Char+colsepp+ = baseParser{bad =+ \ _ ->+ lookAhead+ (try+ (do _ <- try (string "||") <|> try (string "{{!!}}")+ return ())+ <|>+ try+ (do _ <- char '\n'+ return ())+ <|>+ do _ <- try (string "!!")+ return ()),+ start =+ \ _ ->+ try+ (try+ (do _ <- string "\n"+ skipMany (char ' ')+ _ <- try (string "|") <|> try (string "{{!}}")+ _ <- notFollowedBy (oneOf "-}")+ return (Str ""))+ <|>+ do _ <- try (string "||") <|> try (string "{{!!}}")+ return (Str "")),+ end =+ \ _ ->+ try+ (do _ <- try (string "|") <|> try (string "{{!}}")+ _ <- notFollowedBy (oneOf "}|")+ return ()),+ allowed = [Wikitable], self = TableColSep}++{-| parses a column separator without anything inside it -}++colsepp2 :: MyParser Char+colsepp2+ = baseParser{start =+ \ _ ->+ try+ (do _ <- string "\n"+ skipMany (char ' ')+ _ <- try (string "|") <|> try (string "{{!}}")+ _ <- notFollowedBy (oneOf "-}")+ return (Str "2"))+ <|>+ do _ <- try (string "||") <|> try (string "{{!!}}")+ return (Str "2"),+ allowed = [Wikitable], self = TableColSep}++{-| parses a table header column separator, with additional parameters parser to the beginning of the environment. This parser actually parses only the beginning elements and whats inside it See -}++headcolsepp :: MyParser Char+headcolsepp+ = baseParser{bad =+ \ _ ->+ lookAhead+ (try+ (do _ <- try (string "||") <|> (string "{{!!}}")+ return ())+ <|>+ try+ (do _ <- char '\n'+ return ())+ <|>+ do _ <- try (string "!!")+ return ()),+ start =+ \ _ ->+ try+ (do _ <- string "\n"+ skipMany (char ' ')+ _ <- string "!"+ _ <- notFollowedBy (oneOf "-}")+ return (Str ""))+ <|>+ do _ <- string "!!"+ return (Str ("")),+ end =+ \ _ ->+ do _ <- try (char '|') <|> ((string "{{!}}") >> return '|')+ notFollowedBy (oneOf "-}|")+ return (),+ allowed = [Wikitable], self = TableHeadColSep}++{-| parses a header column separator without anything inside it -}++headcolsepp2 :: MyParser Char+headcolsepp2+ = baseParser{start =+ \ _ ->+ try+ (do _ <- string "\n"+ skipMany (char ' ')+ _ <- string "!"+ _ <- notFollowedBy (oneOf "-}")+ return (Str ""))+ <|>+ do _ <- string "!!"+ return (Str ""),+ allowed = [Wikitable], self = TableHeadColSep}++attrinside :: String -> GenParser Char () Char+attrinside x = try (string "&" >> return '&') <|> (noneOf x)++{-| matches a key value pair . So an attribute of an HTML element -}++attr :: GenParser Char () ([Char], [Char])+attr+ = do skipMany1 (oneOf " \n")+ k <- many1 (try (alphaNum) <|> oneOf ":-")+ v <- try+ (do skipMany (oneOf " \n")+ _ <- char '='+ skipMany (oneOf " \n")+ vv <- try+ (do _ <- try (char '"')+ vvv <- many (attrinside "\"><")+ _ <- try (char '"') <|> try (noneOf "<|>") <|> return ' '+ return vvv)+ <|>+ try+ (do _ <- (char '\'')+ vvv <- many (attrinside "'><")+ _ <- try (char '\'') <|> try (noneOf "<|>") <|> return ' '+ return vvv)+ <|>+ (do vvv <- many (attrinside "\"'></| ")+ _ <- try (char '\'') <|> try (char '"') <|> try (noneOf "</|> ")+ <|> return ' '+ return vvv)+ return vv)+ <|> return ""+ return (k, v)++{-| Matches a key value pair. So an attribute of an HTML element -}++attrns :: GenParser Char u ([Char], [Char])+attrns+ = do k <- many1 (try (alphaNum) <|> oneOf ":-")+ v <- do _ <- char '='+ skipMany (oneOf " \n")+ vv <- try+ (do _ <- try (char '"') <|> char '\''+ vvv <- many (noneOf "\"'><|")+ _ <- try (char '"') <|> try (noneOf "<|>") <|> return ' '+ return vvv)+ <|>+ (do vvvv <- (noneOf "\"'></| =")+ vvv <- many (noneOf "\"'></| ")+ _ <- try (char '"') <|> try (char '\'') <|> try (noneOf "</|> ")+ <|> return ' '+ return (vvvv : vvv))+ return vv+ _ <- try (many (oneOf " \n")) <|> return []+ return (k, v)++{-| Matches a list of key value pairs . So all attributes of an HTML element -}++attrp :: MyParser Char+attrp+ = baseParser{start =+ \ _ ->+ do atr <- try (attrns)+ return (Attr atr),+ allowed = [TableHeadColSep, TableColSep, TableCap],+ self = Attribute}++{-| Parses the HTML 'pre' tag -}++prep :: MyParser Char+prep+ = baseParser{start =+ \ _ ->+ do _ <- string "<"+ p <- try (string "pre") <|> try (string "PRE") <|>+ try (string "xmp")+ <|> string "XMP"+ atr <- many (try (attr))+ _ <- try (many (oneOf " \n")) <|> return []+ _ <- char '>'+ return (TagAttr p (Map.fromList atr)),+ end =+ \ (TagAttr x _) ->+ do _ <- char '<'+ _ <- char '/'+ _ <- string x+ _ <- char '>'+ return (),+ allowed = everywhere, self = Preformat}++{-| Parses the HTML 'br' tag -}++brparser :: MyParser Char+brparser+ = baseParser{start =+ \ _ ->+ do _ <- string "<"+ _ <- try (string "/") <|> return ""+ _ <- try (string "br") <|> string ("BR")+ skipMany (try (attr))+ _ <- try (many (oneOf " \n")) <|> return []+ _ <- try (string "/") <|> return ""+ _ <- try (many (oneOf " \n")) <|> return []+ _ <- char '>'+ return (TagAttr "br" Map.empty),+ allowed = SpaceIndent : everywhere, self = Tag}++{-| Returns a Parser that matches all HTML elements, given by the list of strings given as first input parameter. The parser does not match inside tables. Use makettagparser for that -}++maketagparser :: [String] -> MyParser Char+maketagparser tags+ = baseParser{start =+ \ _ ->+ do _ <- string "<"+ t <- (oneOfTheStrings tags)+ atr <- many (try (attr))+ _ <- try (many (oneOf " \n")) <|> return []+ _ <- char '>'+ return (TagAttr (t) (Map.fromList atr)),+ end =+ \ (TagAttr x _) ->+ do _ <- char '<'+ _ <- try (many (oneOf " ")) <|> return []+ _ <- if x `elem` nonNestTags then try (char '/') <|> (return '/')+ else (char '/')+ _ <- string x+ _ <- char '>'+ return (),+ allowed = SpaceIndent : everywheretbl, self = Tag}++{-| Parser for the 'meta' tag of HTML -}++metatagparser :: MyParser Char+metatagparser+ = baseParser{start =+ \ _ ->+ do _ <- string "<"+ t <- (oneOfTheStrings ["meta"])+ atr <- many (try (attr))+ _ <- try (many (oneOf " \n")) <|> return []+ _ <- try (char '/') <|> (return '/')+ _ <- try (char '>') <|> (return '>')+ return (TagAttr (t) (Map.fromList atr)),+ allowed = SpaceIndent : everywhere, self = Tag}++{-| Parser for the !DOCTYPE tag of HTML -}++doctagparser :: MyParser Char+doctagparser+ = baseParser{start =+ \ _ ->+ do _ <- string "<"+ t <- (oneOfTheStrings ["!DOCTYPE"])+ _ <- many (noneOf ">")+ _ <- char '>'+ return (TagAttr (t) (Map.fromList [])),+ allowed = SpaceIndent : everywhere, self = Tag}++{-| Parser for closing HTML tags that have not matching opening tag. -}++ctagparser :: [String] -> GenParser Char () ()+ctagparser tags+ = do _ <- string "</"+ _ <- (oneOfTheStrings tags)+ _ <- try (many (oneOf " \n")) <|> return []+ _ <- char '>'+ return ()++{-| Returns a parser that matches all HTML elements, given by the list of strings given as first input parameter. The parser matches only the opening part of the tag. The inside of it is not processed by this parser. The opening tag may also self closing like <br/> because of the tailing /. -}++maketagparser2 :: [String] -> MyParser Char+maketagparser2 tags+ = baseParser{start =+ \ _ ->+ do _ <- string "<"+ t <- (oneOfTheStrings tags)+ atr <- many (try (attr))+ _ <- try (many (oneOf " \n")) <|> return []+ _ <- try (char '/') <|> (return '/')+ _ <- char '>'+ return (TagAttr (t) (Map.fromList atr)),+ allowed = Wikitable : SpaceIndent : everywheretbl, self = Tag}++{-| Returns a parser that matches all HTML elements, given by the list of strings given as first input parameter. The parser matches only the opening part of the tag. The inside of it is not processed by this parser. The opening tag may not be self closing so not like <br/> because of the tailing /. -}++maketagparser3 :: [String] -> MyParser Char+maketagparser3 tags+ = baseParser{start =+ \ _ ->+ do _ <- string "<"+ t <- (oneOfTheStrings tags)+ atr <- many (try (attr))+ _ <- try (many (oneOf " \n")) <|> return []+ _ <- char '>'+ return (TagAttr (t) (Map.fromList atr)),+ allowed = SpaceIndent : everywheretbl, self = Tag}++{-| tags that can not be nested and are thus allowed to closed by an opening tag instead of a closing one -}++nonNestTags :: [String]+nonNestTags+ = ["tt", "pre", "TT", "PRE", "b", "B", "i", "I", "sc", "SC",+ "code", "CODE"]++{-| Returns a parser that matches all HTML elements, given by the list of strings given as first input parameter. The parser matches only inside tables. Use maketagparser for that -}++makettagparser :: [String] -> MyParser Char+makettagparser tags+ = baseParser{bad =+ \ _ ->+ do _ <- lookAhead (do try (string "\n|") <|> (string "||"))+ return (),+ start =+ \ _ ->+ do _ <- string "<"+ t <- (oneOfTheStrings tags)+ atr <- many (try (attr))+ _ <- try (many (oneOf " \n")) <|> return []+ _ <- char '>'+ return (TagAttr (t) (Map.fromList atr)),+ end =+ \ (TagAttr x _) ->+ do _ <- char '<'+ _ <- try (many (oneOf " ")) <|> return []+ _ <- if x `elem` nonNestTags then try (char '/') <|> (return '/')+ else (char '/')+ _ <- string x+ _ <- char '>'+ return (),+ allowed = [Wikitable], self = Tag}++{-| Returns a parser that matches all HTML elements, given by the list of strings given as first input parameter. The parser matches only the opening part of the tag. The inside of it is not processed by this parser. The opening tag may also self closing like <br/> because of the tailing /. Matches only inside tables -}++makettagparser2 :: [String] -> MyParser Char+makettagparser2 tags+ = baseParser{bad =+ \ _ ->+ do _ <- lookAhead+ (do _ <- anyChar+ try (string "\n|") <|> (string "||"))+ return (),+ start =+ \ _ ->+ do _ <- string "<"+ t <- (oneOfTheStrings tags)+ atr <- many (try (attr))+ _ <- try (many (oneOf " \n")) <|> return []+ _ <- char '/'+ _ <- char '>'+ return (TagAttr (t) (Map.fromList atr)),+ allowed = [Wikitable], self = Tag}++{-| maketagparser for all HTML elements see documentation on function maketagparser -}++tagparser :: MyParser Char+tagparser = maketagparser listOfTags++{-| maketagparser for the 'pre' HTML tag see documentation on function maketagparser -}++tagparserp :: MyParser Char+tagparserp = maketagparser ["pre"]++{-| maketagparser for the HTML tags for HTML tables see documentation on function maketagparser -}++tagparsert :: MyParser Char+tagparsert+ = (maketagparser listOfTableTags){self = TableTag,+ reenv = const Tag}++{-| makettagparser for all HTML elements see documentation on function makettagparser -}++ttagparser :: MyParser Char+ttagparser = makettagparser listOfTags++{-| makettagparser for the 'pre' HTML tag see documentation on function makettagparser -}++ttagparserp :: MyParser Char+ttagparserp = makettagparser ["pre"]++{-| makettagparser for the HTML tags for HTML tables see documentation on function makettagparser -}++ttagparsert :: MyParser Char+ttagparsert+ = (makettagparser listOfTableTags){self = TableTag,+ reenv = const Tag}++{-| maketagparser2 for all HTML elements see documentation on function maketagparser2 -}++tagparser2 :: MyParser Char+tagparser2 = maketagparser2 listOfTags++{-| maketagparser2 for the 'pre' HTML tag see documentation on function maketagparser2 -}++tagparser2p :: MyParser Char+tagparser2p = maketagparser2 ["pre"]++{-| maketagparser2 for the HTML tags for HTML tables see documentation on function maketagparser2 -}++tagparser2t :: MyParser Char+tagparser2t+ = (maketagparser2 listOfTableTags){self = TableTag,+ reenv = const Tag}++{-| makettagparser2 for all HTML elements see documentation on function makettagparser2 -}++ttagparser2 :: MyParser Char+ttagparser2 = makettagparser2 listOfTags++{-| makettagparser2 for the 'pre' HTML tag see documentation on function makettagparser2 -}++ttagparser2p :: MyParser Char+ttagparser2p = makettagparser2 ["pre"]++{-| makettagparser2 for the HTML tags for HTML tables see documentation on function makettagparser2 -}++ttagparser2t :: MyParser Char+ttagparser2t+ = (makettagparser2 listOfTableTags){self = TableTag,+ reenv = const Tag}++{-| a parser for mediawiki source extension tags -}++tagparsers :: MyParser Char+tagparsers+ = (maketagparser ["source", "syntaxhighlight"]){self = Source}++{-| a parser for mediawiki source extension tags inside tables -}++ttagparsers :: MyParser Char+ttagparsers+ = (maketagparser ["source", "syntaxhighlight"]){self = Source,+ allowed = [Wikitable]}++{-| a parser for HTML tables -}++mytablep :: MyParser Char+mytablep+ = (maketagparser ["table"]){self = TableTag,+ reenv = const Wikitable,+ allowed = Wikitable : SpaceIndent : everywheretbl}++{-| a parser for HTML table rows -}++mytrsepp :: MyParser Char+mytrsepp+ = (maketagparser3 ["tr"]){reenv = const TableRowSep,+ allowed = everywhere}++{-| a parser for normal HTML table cells -}++mytcolsepp :: MyParser Char+mytcolsepp+ = (maketagparser3 ["td"]){reenv = const TableColSep,+ allowed = everywhere}++{-| a parser for HTML table captions cells -}++mytcapp :: MyParser Char+mytcapp+ = (maketagparser ["caption"]){reenv = const TableCap,+ allowed = everywhere}++{-| a parser for HTML table header cells, so th tags -}++mythcolsepp :: MyParser Char+mythcolsepp+ = (maketagparser3 ["th"]){reenv = const TableHeadColSep,+ allowed = everywhere}++{-| a parser for HTML tables for html parse mode only -}++htmytablep :: MyParser Char+htmytablep = (maketagparser ["table"])++{-| a parser for HTML table rows for html parse mode only -}++htmytrsepp :: MyParser Char+htmytrsepp = (maketagparser ["tr"])++{-| a parser for normal HTML table cells for html parse mode only -}++htmytcolsepp :: MyParser Char+htmytcolsepp = (maketagparser ["td"])++{-| a parser for HTML table captions cells for html parse mode only -}++htmytcapp :: MyParser Char+htmytcapp = (maketagparser ["caption"])++{-| a parser for HTML table header cells, so th tags for html parse mode only -}++htmythcolsepp :: MyParser Char+htmythcolsepp = (maketagparser ["th"])++{-| a parser for closing HTML tags which don't have an opening partner. This parser is only allowed to match within itemization enumerations etc. -}++itagparser :: MyParser Char+itagparser+ = baseParser{start =+ \ _ ->+ do _ <- string "<"+ skipMany (char '/')+ t <- (oneOfTheStrings ["small"])+ atr <- many (try (attr))+ _ <- try (many (oneOf " \n")) <|> return []+ _ <- char '>'+ return (TagAttr (t) (Map.fromList atr)),+ allowed = [Itemgroup], self = Tag}++{-| a parser for closing HTML tags which don't have an opening partner -}++rtagparser :: MyParser Char+rtagparser+ = baseParser{start =+ \ _ ->+ do _ <- string "<"+ skipMany (char '/')+ s <- (oneOfTheStrings (listOfTags ++ listOfTableTags))+ atr <- many (try (attr))+ _ <- try (many (oneOf " \n")) <|> return []+ _ <- char '>'+ return (TagAttr ("bad" ++ s) (Map.fromList atr)),+ allowed = everywhere, self = Tag}++{-| a parser for HTML opening tags which might be self closing but never have a matching closing partner -}++stagparser :: MyParser Char+stagparser+ = baseParser{start =+ \ _ ->+ do _ <- string "<"+ t <- (oneOfTheStrings (listOfTags ++ listOfTableTags))+ atr <- many (try (attr))+ _ <- try (many (oneOf " ")) <|> return []+ _ <- try (char '/') <|> return 'f'+ _ <- char '>'+ return (TagAttr t (Map.fromList atr)),+ self = Tag, allowed = []}++{-| a parser for HTML page breaks -}++pagebreakp :: MyParser Char+pagebreakp+ = baseParser{start =+ \ _ ->+ do _ <- string "<div style=\"page-break-before:always\"/>"+ return (Str ""),+ end = \ _ -> return (), allowed = everywhere, self = PageBreak}++{-| a parser for HTML comments -}++commentp :: MyParser Char+commentp+ = baseParser{start =+ \ _ ->+ do _ <- string "<!--"+ return (Str ""),+ allowed = everywhere ++ [Tag, TemplateInsideVerbatim],+ end =+ \ _ ->+ do _ <- string "-->"+ return (),+ self = Comment}++{-| a parser for mediawiki reserved words -}++reservedp :: MyParser Char+reservedp+ = baseParser{start =+ \ _ ->+ do s <- try (string "__NOTOC__") <|>+ try (string "__NOEDITSECTION__")+ <|> try (string "__notoc__")+ <|> try (string "__TOC__")+ <|> try (string "__Toc__")+ <|> try (string "__INHALTSVERZEICHNIS__")+ <|> try (string "__KEIN_INHALTSVERZEICHNIS__")+ <|> try (string "__FORCETOC__")+ <|> string " "+ return (Str s),+ self = Reserved, allowed = SpaceIndent : everywhere}++{-| See documentation on evaluateItemgroup and itemParserLevelTwo-}++itemStartString :: Anything Char -> String+itemStartString (ItemStart x) = x : []+itemStartString _ = ""++{-| See documentation on evaluateItemgroup and itemParserLevelTwo -}++itemStopString :: Anything Char -> String+itemStopString (ItemStop x) = x : []+itemStopString _ = ""++{-| see documentation on evaluateItemgroup. Parser to parse the ItemStart and ItemStop elements which are essentially bracket into environments which are essentially nodes with children in the parse tree -}++itemParserLevelTwo :: MyParser (Anything Char)+itemParserLevelTwo+ = MyParser{bad = \ _ -> pzero,+ start =+ \ _ ->+ do pos <- getPosition+ z <- token show (\ _ -> pos)+ (\ x -> if (itemStartString x == []) then Nothing else Just x)+ return (Str (itemStartString z)),+ end =+ \ (Str y) ->+ do pos <- getPosition+ _ <- token show (\ _ -> pos)+ (\ x -> if (itemStopString x == y) then Just x else Nothing)+ return (),+ allowed = [Root, ItemEnv], self = ItemEnv, modify = \ _ x -> x,+ reenv = id}++{-| see documentation on evaluateItemgroup. helper function to generate a list of only opening or only closing brackets, that is ItemStart or ItemStop values. The string given as first parameter states which kinds of bracket shall be opened or closed. For Openning brackets you have to call this function ItemStart as second and True as third parameter. For closing brackets you have to use ItemStop and False -}++generateEnvironmentTagsHelper ::+ String -> (Char -> Anything Char) -> Bool -> [Anything Char]+generateEnvironmentTagsHelper (c : cs) t b+ = if b then+ (t c) : ([Item c]) ++ (generateEnvironmentTagsHelper cs t b) else+ (generateEnvironmentTagsHelper cs t b) ++ [(t c)]+generateEnvironmentTagsHelper [] _ _ = []++{-| see documentation on evaluateItemgroup and insertEnvironmentTags. The first parameter is a string consisting of the characters #:* that is the begging of the last Itemline. The second is the same for the current ItemLine. This function return a list of ItemStart and ItemStop values for the difference between the first and the second parameter -}++generateEnvironmentTags :: String -> String -> [Anything Char]+generateEnvironmentTags (o : os) (n : ns)+ = if (o == n) then generateEnvironmentTags os ns else+ (generateEnvironmentTagsHelper (o : os) ItemStop False) +++ (generateEnvironmentTagsHelper (n : ns) ItemStart True)+generateEnvironmentTags (o : os) []+ = generateEnvironmentTagsHelper (o : os) ItemStop False+generateEnvironmentTags [] (n : ns)+ = generateEnvironmentTagsHelper (n : ns) ItemStart True+generateEnvironmentTags [] [] = []++{-| see documentation on evaluateItemgroup. The first parameter is a string consisting of the characters #:* that is the begging of the last Itemline. The second parameter is the content of an Itemgroup. This function returns the parse tree with the ItemStart and ItemStop values inserted -}++insertEnvironmentTags ::+ String -> [Anything Char] -> [Anything Char]+insertEnvironmentTags s ((Environment ItemLine (Str x) _) : xs)+ = (generateEnvironmentTags s x) +++ ((if+ (((length s) > (length x)) &&+ (if length (generateEnvironmentTags s x) > 0 then+ (case last (generateEnvironmentTags s x) of+ Item _ -> False+ _ -> True)+ else True)+ && (x /= ""))+ || (s == x)+ then [Item (last s)] else [])+ ++ insertEnvironmentTags x xs)+insertEnvironmentTags s (x : xs) = x : insertEnvironmentTags s xs+insertEnvironmentTags _ [] = []++{-| see documentation on evaluateItemgroup. Inserts the ItemStart and ItemStop values as preparation for running the second level parse on the content of an ItemGroup. The first pararmenter is a string consisting of the characters #:* that is the begging of the first Itemline. The second parameter is the content of an Itemgroup. This function returns the parse tree with the ItemStart and ItemStop values inserted -}++toEnvironmentTags :: String -> [Anything Char] -> [Anything Char]+toEnvironmentTags s l+ = insertEnvironmentTags ""+ ((Environment ItemLine (Str s) []) :+ l ++ [(Environment ItemLine (Str "") [])])++{-| see documentation on evaluateItemgroup. Get the second level parse result, back to the first level parse result -}++convertFromParsingLevelTwoToLevelOne ::+ [Anything (Anything Char)] -> [Anything Char]+convertFromParsingLevelTwoToLevelOne ((C x) : xs)+ = x : convertFromParsingLevelTwoToLevelOne xs+convertFromParsingLevelTwoToLevelOne ((Environment Root _ x) : xs)+ = (convertFromParsingLevelTwoToLevelOne x) +++ (convertFromParsingLevelTwoToLevelOne xs)+convertFromParsingLevelTwoToLevelOne+ ((Environment ItemEnv s l) : xs)+ = (Environment ItemEnv s+ (findMatchingBrackets (remake parsers)+ ((convertFromParsingLevelTwoToLevelOne l))))+ : convertFromParsingLevelTwoToLevelOne xs+convertFromParsingLevelTwoToLevelOne (_ : xs)+ = (convertFromParsingLevelTwoToLevelOne xs)+convertFromParsingLevelTwoToLevelOne [] = []++{-| see documentation on evaluateItemgroup. Runs the parser itemParserLevelTwo on the inner part of an ItemGroup -}++runItemGroupPraserLevelTwo ::+ GenParser (Anything Char) () [Anything (Anything Char)] ->+ [Anything Char] -> [Anything (Anything Char)]+runItemGroupPraserLevelTwo p input+ = case (parse p "" input) of+ Left _ -> []+ Right x -> x++{-| this is for parsing itemization. It is implemented as two step process in the first step Itemgroup is created with ItemLine s in it. And ItemLine is a line starting with any combination of *#: . And Itemgroup is a sequence of lines of that kind. After this is done this function gets called with the content of an itemgroup. In the second step ItemStart and ItemStop elements are created, those are essentially the bracketed of the opening an closing part of the enumerations itemizations etc. . The function toEnvironmentTags does the insertion of the ItemStop and ItemStart values and remove the ItemLine values. parseAnything2 is run on it using the itemParserLevelTwo. This is turned into the parse tree by being passed to decon2 and put out of the parser monad by runItemGroupPraserLevelTwo. The resulting parse tree is one of type [Anything (Anything Char)] this needs to be but one level down to [Anything Char] this is done be convertFromParsingLevelTwoToLevelOne. The first parameter is a string consisting of the characters #:* that is the begging of the first Itemline. The second parameter is the content of an Itemgroup -}++evaluateItemgroup :: String -> [Anything Char] -> [Anything Char]+evaluateItemgroup s l+ = convertFromParsingLevelTwoToLevelOne+ (runItemGroupPraserLevelTwo+ (decon2 (remake [itemParserLevelTwo])+ (parseAnything2+ [MyStackFrame{endparser = pzero, startdata = Str "",+ environment = Root, badparser = \ _ -> pzero, parsernumber = 0,+ nestingdepth = 0}]+ (remake [itemParserLevelTwo])+ []))+ (toEnvironmentTags s l))++{-| a parser for a group of lines starting with one of *:;# representing in enumeration itemization etc. . This particular parser is allowed to match nearly everywhere -}++itempgroupp :: MyParser Char+itempgroupp+ = MyParser{bad = \ _ -> pzero,+ start =+ \ _ ->+ (do _ <- string "\n"+ a <- many1 (oneOf ['*', ':', ';', '#'])+ return (Str a)),+ end =+ \ _ ->+ lookAhead+ (try+ (do _ <- string "\n"+ notFollowedBy ((oneOf ['*', ':', ';', '#'])))),+ allowed = [Root, Wikitable, TemplateInside, Tag], self = Itemgroup,+ modify = \ (Str x) -> evaluateItemgroup x, reenv = id}++{-| a parser for a group of lines starting with one of *:;# representing in enumeration itemization etc. . This particular parser is only allowed to match within templates -}++itempgrouppt :: MyParser Char+itempgrouppt+ = MyParser{bad = \ _ -> pzero,+ start =+ \ _ ->+ do _ <- string "\n"+ a <- many1 (oneOf ['*', ':', ';', '#'])+ return (Str a),+ end =+ \ _ ->+ (try+ (lookAhead (string "}}") <|>+ (lookAhead (string "\n" >> (many (char ' ')) >> string "|")))+ >> return ()),+ allowed = [TemplateInside], self = Itemgroup,+ modify = \ (Str x) -> evaluateItemgroup x, reenv = id}++{-| a parser for a preformat created by indenting with space -}++presectionp :: MyParser Char+presectionp+ = MyParser{bad = \ _ -> try (string "}}") >> (return ()),+ start =+ \ _ ->+ do _ <- string "\n"+ _ <- char ' '+ return (Str ""),+ end =+ \ _ ->+ lookAhead+ (do _ <- string "\n"+ notFollowedBy (char ' ')),+ allowed = [Root, Tag], self = SpaceIndent,+ modify = \ _ x -> (C ' ') : x, reenv = id}++{-| a parser for a preformat created by indenting with space withing templates -}++presectionpt :: MyParser Char+presectionpt+ = MyParser{bad = \ _ -> try (string "}}") >> (return ()),+ start =+ \ _ ->+ do _ <- string "\n"+ _ <- notFollowedBy ((many1 (char ' ')) >> (char '|'))+ _ <- char ' '+ return (Str ""),+ end =+ \ _ ->+ lookAhead+ (do _ <- string "\n"+ notFollowedBy (char ' ')),+ allowed = [TemplateInside], self = SpaceIndent,+ modify = \ _ x -> (C ' ') : x, reenv = id}++{-| a parser for a line starting with one of *:;# representing in enumeration itemization etc. -}++itemlinep :: MyParser Char+itemlinep+ = MyParser{bad = \ _ -> pzero,+ start =+ \ _ ->+ do _ <- string "\n"+ a <- many1 (oneOf ['*', ':', ';', '#'])+ return (Str a),+ end = \ _ -> (return ()), allowed = [Itemgroup], self = ItemLine,+ modify = \ _ x -> x, reenv = id}++{-| takes a parse tree that was created form the HTML returned by MediaWiki when being requested for the print version of a wiki page. And returns a modified version of that parse tree ready for being converted to LaTeX with treeToLaTeX3 |-}++printPrepareTree :: [Anything Char] -> [Anything Char]+printPrepareTree ll = concat (map printPrepareNode ll)+ where printPrepareNode :: Anything Char -> [Anything Char]+ printPrepareNode (Environment Tag (TagAttr "div" mm) l)+ | (Map.lookup "class" mm) == (Just "thumbinner") =+ case+ do (m, llll) <- case filter (mypred "a") (reducediv l) of+ [(Environment Tag (TagAttr "a" mmm) lll)] -> return (mmm, lll)+ _ -> mzero+ tt <- case filter (mypred "div") (reducediv l) of+ [(Environment Tag (TagAttr "div" mmm) tt)] | (Map.lookup "class"+ mmm)+ == (Just "thumbcaption")+ ->+ return .+ (dropWhile (== (C '\n')))+ . (filter magnpred)+ $ tt+ _ -> mzero+ return $ imgfun m (printPrepareTree llll) (Just (printPrepareTree tt))+ of+ Just x -> x+ _ -> printPrepareTree l+ printPrepareNode (Environment Wikitable (TagAttr "table" m) _)+ | (Map.lookup "class" m) == (Just "toc") = []+ printPrepareNode (Environment Tag (TagAttr "tbody" _) x)+ = printPrepareTree x+ printPrepareNode (Environment Tag (TagAttr "div" m) _)+ | ((Map.lookup "class" m) == (Just "toc") ||+ (Map.lookup "id" m) == (Just "toc"))+ = []+ printPrepareNode (Environment Wikitable (TagAttr "table" m) _)+ | (Map.lookup "class" m) == (Just "navbox") = []+ printPrepareNode (Environment Tag (TagAttr "title" _) _) = []+ printPrepareNode (Environment Tag (TagAttr "div" m) _)+ | (Map.lookup "id" m) == (Just "siteSub") = []+ printPrepareNode (Environment Tag (TagAttr "div" m) _)+ | (Map.lookup "id" m) == (Just "catlinks") = []+ printPrepareNode (Environment Tag (TagAttr "div" m) _)+ | (Map.lookup "id" m) == (Just "jump-to-nav") = []+ printPrepareNode (Environment Tag (TagAttr "div" m) _)+ | (Map.lookup "id" m) == (Just "footer") = []+ printPrepareNode (Environment Tag (TagAttr "div" m) _)+ | (Map.lookup "id" m) == (Just "p-lang") = []+ printPrepareNode (Environment Tag (TagAttr "div" m) _)+ | (Map.lookup "id" m) == (Just "contentSub") = []+ printPrepareNode (Environment Tag (TagAttr "span" m) _)+ | (Map.lookup "style" m) == (Just "display:none") = []+ printPrepareNode (Environment Tag (TagAttr "div" m) _)+ | (Map.lookup "class" m) == (Just "printfooter") = []+ printPrepareNode (Environment Tag (TagAttr "span" m) _)+ | (Map.lookup "class" m) == (Just "mw-cite-backlink") = []+ printPrepareNode (Environment Tag (TagAttr "a" m) _)+ | (Map.lookup "class" m) == (Just "mw-jump-link") = []+ printPrepareNode (Environment Tag (TagAttr "div" m) _)+ | (Map.lookup "id" m) == (Just "mw-navigation") = []+ printPrepareNode (Environment Tag (TagAttr "sup" m) l)+ | (Map.lookup "class" m) == (Just "reference") =+ [Environment Tag (TagAttr "sup" m) (reducea l)]+ printPrepareNode (Environment Tag (TagAttr "li" m) l)+ | (Map.lookup "class" m) == (Just "gallerybox") =+ case+ (do llll <- case deepGet "div" "class" "thumb" l of+ [Environment Tag (TagAttr "div" _) lll] -> return lll+ _ -> mzero+ (mmm, lll) <- case deepGet "a" "class" "image" llll of+ [Environment Tag (TagAttr "a" mmm) lll] -> return (mmm, lll)+ _ -> mzero+ te <- case deepGet "div" "class" "gallerytext" l of+ [Environment Tag (TagAttr "div" _) te] -> return te+ _ -> mzero+ return $ imgfun mmm (printPrepareTree lll) (Just te))+ of+ Just x -> x+ _ -> printPrepareTree l+ printPrepareNode (Environment TableHeadColSep (TagAttr t m) l)+ = [Environment TableHeadColSep (TagAttr t m)+ (l +++ (map (\ x -> Environment Attribute (Attr x) []) (Map.toList m)))]+ printPrepareNode (Environment TableColSep (TagAttr t m) l)+ = [Environment TableColSep (TagAttr t m)+ (l +++ (map (\ x -> Environment Attribute (Attr x) []) (Map.toList m)))]+ printPrepareNode (Environment TableRowSep (TagAttr t m) l)+ = [Environment TableRowSep (TagAttr t m)+ (l +++ (map (\ x -> Environment Attribute (Attr x) []) (Map.toList m)))]+ printPrepareNode (Environment Tag (TagAttr "pre" m) l)+ = [Environment Preformat (TagAttr "pre" m) l]+ printPrepareNode (Environment Tag (TagAttr "span" m) _)+ | (Map.lookup "class" m) == (Just "editsection") = []+ printPrepareNode (Environment Tag (TagAttr "span" m) _)+ | (Map.lookup "class" m) == (Just "mw-editsection") = []+ printPrepareNode (Environment Tag (TagAttr "a" m) l)+ = case (Map.lookup "class" m) of+ (Just "image") -> imgfun m (printPrepareTree l) Nothing+ _ -> case (Map.lookup "class" m) of+ (Just "external free") -> [Environment Tag (TagAttr "a" m) []]+ _ -> [Environment Tag (TagAttr "a" m) l]+ printPrepareNode (Environment Tag (TagAttr "div" m) _)+ | (Map.lookup "class" m) == (Just "bodyContent") = []+ printPrepareNode (Environment Tag (TagAttr "math" m) l)+ = case deepGet "annotation" "encoding" "application/x-tex" l of+ [Environment Tag (TagAttr "annotation" _) x] -> [Environment Math+ (TagAttr "math" m)+ (map C+ (replace2+ (replace2+ (replace2+ (shallowFlatten x)+ "&"+ "&")+ "<"+ "<")+ ">"+ ">"))]+ _ -> []+ printPrepareNode (Environment Tag (TagAttr "img" m) l)+ | (Map.lookup "class" m) `elem`+ (map Just+ ["tex", "mwe-math-fallback-png-inline tex",+ "mwe-math-fallback-image-inline tex"])+ =+ case Map.lookup "alt" m of+ Just x -> [Environment Math (TagAttr "math" m)+ (map C+ (replace2 (replace2 (replace2 x "&" "&") "<" "<") "gt;"+ ">"))]+ Nothing -> [(Environment Tag (TagAttr "img" m)+ (printPrepareTree l))]+ printPrepareNode (Environment Tag (TagAttr "div" m) l)+ = case+ do c <- Map.lookup "class" m+ guard $ ((isInfixOf "source" c) || (isInfixOf "highlight" c))+ return $+ Environment Source+ (TagAttr "source"+ (Map.fromList [("lang", (takeWhile (/= ' ') c))]))+ (deepFlatten l)+ of+ Nothing -> [Environment Tag (TagAttr "div" m) (printPrepareTree l)]+ Just x -> [x]+ printPrepareNode (Environment x y l)+ = [Environment x y (printPrepareTree l)]+ printPrepareNode x = [x]+ + mypred :: String -> Anything Char -> Bool+ mypred x y+ = case y of+ (Environment Tag (TagAttr z _) _) | z == x -> True+ _ -> False+ + magnpred :: Anything Char -> Bool+ magnpred y+ = case y of+ (Environment Tag (TagAttr "div" m) _) | (Map.lookup "class" m) ==+ (Just "magnify")+ -> False+ _ -> True+ unEsc x+ = let z = unEscapeString x in+ if isUTF8Encoded z then decodeString z else z+ imgfun m l tt+ = maybeToList $+ do t <- case+ (fmap (parseit imgparsers) (Map.lookup "title" m)) `mplus` tt of+ Just x -> return $ [C '|'] ++ x+ Nothing -> return []+ h <- case filter (mypred "img") l of+ [(Environment Tag (TagAttr "img" mmm) _)] -> case+ Map.lookup "src" mmm of+ Just s -> if+ length+ (reverse+ (splitOn+ "/"+ s))+ >= 2+ then+ return+ ("File:" +++ (unEsc+ ((reverse+ (splitOn+ "/"+ s))+ !!+ (if+ "thumb"+ `elem`+ splitOn+ "/"+ s+ then+ 1+ else+ 0))))+ else mzero+ _ -> mzero+ _ -> mzero+ w <- case+ case filter (mypred "img") l of+ [(Environment Tag (TagAttr "img" mmm) _)] -> do ma <- Map.lookup+ "width"+ mmm+ guard $ tt == Nothing+ return ma+ _ -> Nothing+ of+ Just x -> return $ [C '|'] ++ (map C (x ++ "px"))+ Nothing -> return []+ return (Environment Wikilink (Str "") ((map C h) ++ w ++ t))
src/MegaFont.hs view
@@ -1,7 +1,9 @@-+{-| module storing information on which ttf font should be used for which character and fontstyle -} module MegaFont where import BaseFont- ++{-| map (written as list) storing information on which ttf font should be used for which character and fontstyle -}+ megafont :: [(FontStyle, [Char])] megafont = [(FontStyle{stylebase = Normal, bold = False, italic = False},
src/MyState.hs view
@@ -1,13 +1,13 @@-{-DHUN| A module for mutable states used in the programm DHUN-}+{-| A module for mutable states used in the programm -} module MyState where import qualified Data.Map as Map-import Data.Map (Map)+import Data.Map.Strict (Map) import Control.Monad.Trans.State (State) import MediaWikiParseTree import BaseFont- -{-DHUN| a type used as mutable state while processing a table. See documentation of the TableHelper module DHUN-}- ++{-| a type used as mutable state while processing a table. See documentation of the TableHelper module -}+ data TableState = TableState{rowCounter :: Int, inputLastRowOfHeader :: Int, outputLastRowOfHeader :: Int, outputTableHasHeaderRows :: Bool,@@ -19,21 +19,21 @@ currentRowIsHeaderRow :: Bool, lastCellWasNotFirstCellOfRow :: Bool, columnsWidthList :: [Float], lastCellWasMultiColumn :: Bool, activeColumn :: Maybe Int}- -{-DHUN| see documentation of the makeLables function in WikiHelper module DHUN-}- ++{-| see documentation of the makeLables function in WikiHelper module -}+ data UrlState = UrlState{iUrlState :: Int, sUrlState :: String, mUrlState :: Map String String} deriving (Show, Eq, Read)- -{-DHUN| see initial value of the type UrlState DHUN-}- ++{-| see initial value of the type UrlState -}+ initialUrlState :: UrlState initialUrlState = UrlState{iUrlState = 0, sUrlState = "", mUrlState = Map.empty}- -{-DHUN a type used as mutable state during the course of the LaTeXRederer DHUN-}- ++{-| a type used as mutable state during the course of the LaTeXRederer -}+ data MyState = MyState{getImages :: [String], getJ :: Int, getF :: Float, getC :: Int, getInTab :: Int, getInGallery :: Bool, getInFootnote :: Bool, getInHeading :: Bool, getInCenter :: Bool,@@ -42,15 +42,16 @@ urld :: WikiUrlData, getGalleryNumbers :: [Integer], currentUrl :: String, fndict :: Map String [Anything Char], tablist :: [[String]], tabmap :: Map Int (Map Int Double),- fontStack :: [FontStyle], font :: Font}+ fontStack :: [FontStyle], font :: Font, langu :: Maybe String,+ forms :: Map String Int, lastChar :: Char, lastFontChanged :: Bool} deriving (Show, Eq)- -{-DHUN| Renderer is the State monad using MyState as mutable state DHUN-}- ++{-| Renderer is the State monad using MyState as mutable state -}+ type Renderer = State MyState- -{-DHUN| the initial value for MyState DHUN-}- ++{-| the initial value for MyState -}+ initialState :: MyState initialState = MyState{getImages = [], getJ = 1, getF = 1, getC = 1,@@ -62,27 +63,28 @@ tabmap = Map.empty, fontStack = [FontStyle{stylebase = Normal, bold = False, italic = False}],- font = ComputerModernRoman}- -{-DHUN| represents an URL to a wiki (not to a page thereof), which is not a sister project of wikipedia, so not wikibooks wikisource, etc. DHUN-}- + font = ComputerModernRoman, langu = Nothing, forms = Map.empty,+ lastChar = ' ', lastFontChanged = False}++{-| represents an URL to a wiki (not to a page thereof), which is not a sister project of wikipedia, so not wikibooks wikisource, etc. -}+ data WikiBaseUrl = WikiBaseUrl{baseUrl :: String} deriving (Show, Eq)- -{-DHUN| represents an URL to a wiki (not to a page thereof), which is a sister project of wikipedia, so wikibooks wikisource, etc. DHUN-}- ++{-| represents an URL to a wiki (not to a page thereof), which is a sister project of wikipedia, so wikibooks wikisource, etc. -}+ data WikiUrlInfo = WikiUrlInfo{language :: String, wikitype :: String} deriving (Show, Eq)- -{-DHUN| represents an URL to a wiki (not to a page thereof), which is either a sister project of wikipedia, so wikibooks wikisource, etc. or isn't a sister project of wikipedia DHUN-}- ++{-| represents an URL to a wiki (not to a page thereof), which is either a sister project of wikipedia, so wikibooks wikisource, etc. or isn't a sister project of wikipedia -}+ data WikiUrlData = BaseUrl WikiBaseUrl | UrlInfo WikiUrlInfo deriving (Show, Eq)- -{-DHUN| represents an URL to a page on a wiki DHUN-}- ++{-| represents an URL to a page on a wiki -}+ data WikiLinkInfo = WikiLinkInfo{urldata :: WikiUrlData, page :: String} deriving (Show, Eq)
src/Parallel.hs view
@@ -1,70 +1,93 @@-+{-| module for parallel computations. The paralellism is reached by forking threads with liftIO. When starting a thread and empty MVar is returned immediately. The MVar is filled on completing of the thread. Normal function can be lifted to threaded function operation on MVar of the parameters instead of the parameters themself. Thus it is possible to define dependencies of function on the return values of other functions and let the order of excecution evolove automatically, so a function is called as soon as all its parameters have been calculated. All functions considered in this module are understood to have an IO return type. This module is mainly used for paraller downloading from the web. -} module Parallel where import Control.Concurrent.MVar-import Control.Concurrent- -(<$>) :: (a -> IO b) -> MVar a -> IO (MVar b)-f <$> x++{-| takes a function of return type IO which takes on parameter and an MVar containing at the same type as the parameter of the function and returns and IO action containing an MVar containing the same type as the tyoe contained in the IO Action returned by the function. This function retuns immediately and passed an empty MVar as return type. As soon as the MVar containing the same type as the parameter of the function is ready for reading the the function is executed in a new thread. As soon as the function return a value, the it is written into the returned MVar. -}++(<$$>) :: MVar Int -> (a -> IO b) -> MVar a -> IO (MVar b)+(<$$>) vv f x = do var <- newEmptyMVar- _ <- forkOS (go var)+ _ <- myFork vv (go var) return var where go v = do xx <- readMVar x result <- f xx putMVar v result- -base :: a -> IO (MVar a)-base = pure . return- -pure :: IO a -> IO (MVar a)-pure x++{-| takes a value and returns an IO action that contain a filled MVar conatining the value -}++base :: MVar Int -> a -> IO (MVar a)+base v x = ((ppure v) . return) x++{-| takes an IO action and return an MVar containing the and IO action the returns an MVar containing the same type as contained by the IO action passed to this function. The IO action passed as first parameter to this function is executed in a new thread. As soon as it finishes its result is written into the returned MVar -}++ppure :: MVar Int -> IO a -> IO (MVar a)+ppure vv x = do var <- newEmptyMVar- _ <- forkOS (go var)+ _ <- myFork vv (go var) return var where go v = do result <- x putMVar v result- -liftList :: ([a] -> IO b) -> [MVar a] -> IO (MVar b)-liftList f x++{-| alias to switch between forkOS and forkIO for testing -}++myFork :: MVar Int -> IO () -> IO ()+myFork _ x = x++{-| takes a function which takes a list and return an IO action as first parameter. It takes a list of MVar containing the same type as the type contained in the list as second parameter. It returnes an empty MVar immediately. As soon as all MVar in the list given as second parameter could be read, the function is started in a new thread. As soon as it finishes, the returend MVar is filled with the value returend by the function -}++liftList :: MVar Int -> ([a] -> IO b) -> [MVar a] -> IO (MVar b)+liftList vv f x = do var <- newEmptyMVar- _ <- forkOS (go var)+ _ <- myFork vv (go var) return var where go v = do xx <- mapM readMVar x result <- f xx putMVar v result- -liftList2 :: ([a] -> IO b) -> MVar [MVar a] -> IO (MVar b)-liftList2 f x++{-| the same as liftList. Only difference is that the seconds parameter is not a list of MVars containing values but an MVar containing a list of MVars containing values. So an addinal step is made to read the out MVar -}++liftList2 ::+ MVar Int -> ([a] -> IO b) -> MVar [MVar a] -> IO (MVar b)+liftList2 vv f x = do var <- newEmptyMVar- _ <- forkOS (go var)+ _ <- myFork vv (go var) return var where go v = do xxx <- readMVar x xx <- mapM readMVar xxx result <- f xx putMVar v result- -liftA :: (a -> IO b) -> MVar a -> IO (MVar b)-liftA f x = f <$> x- -liftA2 :: (a -> b -> IO c) -> MVar a -> MVar b -> IO (MVar c)-liftA2 f x y++{-| prefix version of the angle bracked dollar operator described above -}++liftA :: MVar Int -> (a -> IO b) -> MVar a -> IO (MVar b)+liftA v f x = (<$$>) v f x++{-| same as liftA. Just function must have exactly two parameter instead of only one -}++liftA2 ::+ MVar Int -> (a -> b -> IO c) -> MVar a -> MVar b -> IO (MVar c)+liftA2 vv f x y = do var <- newEmptyMVar- _ <- forkOS (go var)+ _ <- myFork vv (go var) return var where go v = do xx <- readMVar x yy <- readMVar y result <- f xx yy putMVar v result- ++{-| same as liftA. Just function must have exactly three parameter instead of only one -}+ liftA3 ::- (a -> b -> c -> IO d) -> MVar a -> MVar b -> MVar c -> IO (MVar d)-liftA3 f x y z+ MVar Int ->+ (a -> b -> c -> IO d) -> MVar a -> MVar b -> MVar c -> IO (MVar d)+liftA3 vv f x y z = do var <- newEmptyMVar- _ <- forkOS (go var)+ _ <- myFork vv (go var) return var where go v = do xx <- readMVar x
src/Server.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}+{-| Server module, allows mediawiki2latex to run as webserver -} module Server where import Data.Text (Text) import Happstack.Server hiding (body)@@ -9,64 +10,587 @@ import Control.Monad.Trans import Data.ByteString.UTF8 import Data.ByteString.Lazy+ hiding (pack, reverse, takeWhile, dropWhile) import Control.Concurrent import Control.Monad.State import ImperativeState hiding (name) import Hex-import System.Cmd- +import Data.Map.Strict+import Data.Maybe+import System.Process hiding (cwd)+import Data.List+import Text.Blaze.Internal+import Data.Time.Clock.POSIX+import Data.Text (pack)+import Control.DeepSeq+import System.Exit++mytext :: String -> H.Html+mytext = text . pack++pageFrame :: H.Html -> H.Html+pageFrame input+ = H.table H.!+ A.style+ "min-width:100%;border:0px;padding:0;border-spacing:0px 0px;"+ $+ do H.tr H.! A.style "min-width:100%;border:0px;padding:0" $+ do H.td H.! A.style "background-color:#444444" H.! A.colspan "3" $+ do H.div H.!+ A.style+ "color:white;font-size:60;border:20px;font-family:Arial,Helvetica,sans-serif;"+ $ H.b $ do mytext "MediaWiki2LaTeX"+ H.tr H.! A.style "min-width:100%;border:0px;padding:0" $+ do H.td H.! A.style "background-color:#222222" H.! A.colspan "3" $+ H.div H.! A.style "padding: 5px;padding-left: 10px" $+ H.div H.!+ A.style+ "padding:3px;display:inline;background-color:#595959;border-radius:3px"+ $+ H.div H.!+ A.style+ "font-family: times, serif;display:inline;font-size:20;color:#cccccc"+ $ "Home"+ H.tr $+ do H.td $+ H.table H.! A.style "padding:20px" $+ do H.tr $+ infoBox "MediaWiki to LaTeX"+ "MediaWiki to LaTeX converts Wiki pages to LaTeX and PDF. It works with any website running MediaWiki, especially Wikipedia and Wikibooks. MediaWiki to LaTeX is purely written in the purely functional language Haskell. It was mainly devolved by Dirk H\252nniger. The source code is freely available under the terms of the GNU General Public License. Binary releases for the most common operating systems are available for download. The Debian package is maintained by Georges Khaznadar."+ H.tr $+ infoBox "Contact" $+ do mytext "Dirk H\252nniger"+ H.br+ mytext "Emil Schweitzer Str. S 10"+ H.br+ mytext "D-47506 Neukirchen Vluyn"+ H.br+ mytext "Germany"+ H.br+ mytext "Telephone ++49-2845-3799993"+ H.br+ H.a H.!+ A.href+ "mailto:dirk.hunniger@googlemail.com?Subject=MediaWiki2LaTeX"+ $ "dirk.hunniger@googlemail.com"+ input+ H.td $+ H.table H.! A.style "padding:20px" $+ do H.tr $+ infoBox "Documentation and Links" $+ do H.ul $+ do H.li $+ H.a H.!+ A.href+ "http://de.wikibooks.org/wiki/Benutzer:Dirk_Huenniger/wb2pdf/manual"+ $ "Users Manual"+ H.li $+ H.a H.!+ A.href+ "http://de.wikibooks.org/wiki/Benutzer:Dirk_Huenniger/wb2pdf"+ $ "Project Wiki Page"+ H.li $+ H.div H.! A.style "font-size:x-large" $+ do H.b $+ H.a H.!+ A.href+ "https://de.wikibooks.org/wiki/Benutzer:Dirk_Huenniger/wb2pdf"+ $ "Download Full Version for Free"+ H.li $+ H.a H.!+ A.href "http://sourceforge.net/p/wb2pdf/git/ci/master/tree/"+ $ "Git Sourcecode Repository"+ H.li $+ H.a H.!+ A.href+ "http://de.wikibooks.org/wiki/Benutzer_Diskussion:Dirk_Huenniger/wb2pdf/Requests"+ $ "Bug Tracker"+ H.tr $+ infoBox "Web Interface" $+ do mytext+ "The web interface was artistically designed by Thomas Blume using "+ H.a H.! A.href "http://www.yaml.org/" $ "YAML"+ mytext+ ". It was technically implemented by Dirk H\252nniger using the Blaze Html Framework in Haskell. Important ideas on the design of the user interface were contributed by Georges Khaznadar and Martin Wermers. The server this interface is running on is run by a WMF, who have to cover the costs, so "+ H.b "please consider downloading the full version for free"+ mytext+ " and running at on your own hardware instead of using this server."++infoBox :: String -> H.Html -> H.Html+infoBox heading content+ = H.td $+ H.div H.! A.style "padding:10px" $+ H.div H.!+ A.style+ "text-align:jusitfy;text-justify:inter-word;padding:20px;border-color:#aaaaaa;background-color:#f4f4f4;border-radius:5px;border-width:1px;border-style:solid;font-family:Arial,Helvetica,sans-serif"+ $+ do H.div H.! A.style "font-size:30" $ H.b (mytext heading)+ H.br+ H.div H.! A.style "text-align:jusitfy" $ content++data ProgressInfo = ProgressInfo{progress :: Double,+ filename :: Maybe String, startTime :: Double, barValue :: Double,+ lastStepTime :: Double, lastRuntime :: Double, extension :: String,+ failed :: Bool}++instance NFData ProgressInfo where+ rnf a = a `seq` ()++{-| IO action to run the server -}+ serve :: Int -> IO ()-serve p = simpleHTTP nullConf{port = p} formPage- +serve p+ = do a <- newMVar Data.Map.Strict.empty+ simpleHTTP nullConf{port = p, timeout = 100000} $+ msum+ [dirs "progress" $ path $ \ subject -> progressBar a subject,+ dirs "file" $ path $ \ subject -> fileFrame a subject,+ dirs "fill" $ path $ \ subject -> formPage a subject,+ formPage a ""]++{-| template for the start page of the server -}+ template :: Text -> H.Html -> Response template title body = toResponse $- H.html $- do H.head $ do H.title (H.toHtml title)+ H.docTypeHtml $+ do H.head $+ do H.meta H.! A.charset "utf-8"+ H.title (H.toHtml title) H.body $ do body- -mainAction :: String -> String -> IO String-mainAction url filename++{-| takes an url to a wiki article and a filename for the temporary file to be created and return a shell command to run mediawiki2latex to compile a pdf document from the given url and write it to the given temporary filename -}++mainAction :: FullConfig -> IO String+mainAction oldcfg = do cwd <- getCurrentDirectory- let cfg- = FullConfig{resolution = 300, outputFilename = filename,- inputUrl = url, runMode = ImperativeState.HTML, paper = "A4",- vector = False, ImperativeState.copy = Nothing, mainPath = cwd,- server = Nothing}+ let cfg = oldcfg{mainPath = cwd} return (hex (show cfg))- -formPage :: ServerPart Response-formPage++{-| main webpage of the server containing a from with an entry for an url to a wiki article with returns the pdf on submission of the form -}++gogo :: Eq b => [(a, b)] -> b -> b+gogo ((_, v) : xs) vv+ = if vv == v then+ case xs of+ (h : _) -> (snd h)+ _ -> v+ else gogo xs vv+gogo [] vv = vv++progressBar ::+ MVar (Map Int ProgressInfo) -> String -> ServerPart Response+progressBar t sub+ = do let theIndex+ = case+ (reads (Data.List.takeWhile (/= '.') sub)) :: [(Int, String)] of+ ((k, _) : _) -> k+ _ -> 1+ m <- liftIO (takeMVar t)+ let uu+ = (fromMaybe progressInfoZero (Data.Map.Strict.lookup theIndex m))+ let nextKnownRelativeProgressToBeReached+ = gogo mylist (progress uu)+ let lastReachedKnownRelativeProgress = progress uu+ let timeOfLastReachedKnownRelativeProgress = lastStepTime uu+ ttime <- liftIO getPOSIXTime+ let time = (realToFrac ttime)+ let expectedRuntime+ = if lastReachedKnownRelativeProgress < 1.0e-2 then 60.0 else+ (time - (startTime uu)) / lastReachedKnownRelativeProgress+ let runtime = time - startTime uu+ let p = lastReachedKnownRelativeProgress ++ (1 -+ exp+ (-(time - timeOfLastReachedKnownRelativeProgress) /+ (expectedRuntime *+ (nextKnownRelativeProgressToBeReached -+ lastReachedKnownRelativeProgress))))+ *+ (nextKnownRelativeProgressToBeReached -+ lastReachedKnownRelativeProgress)+ let oldProgressBarValue = barValue uu+ let progressBarValue+ = oldProgressBarValue ++ (max+ ((p - oldProgressBarValue) * (runtime - (lastRuntime uu)) / 5.0)+ 0.0)+ let prog+ = if lastReachedKnownRelativeProgress == 1.0 then 1000 else+ if failed uu then 0 else+ round (progressBarValue * 1000.0) :: Integer+ liftIO $+ if not (member theIndex m) then putMVar t m else+ putMVar t $!!+ (Data.Map.Strict.insert theIndex+ uu{barValue = progressBarValue, lastRuntime = runtime}+ m)+ case filename uu of+ Nothing -> do method GET+ ok $+ template "Converting" $+ pageFrame $+ infoBox+ (if not (member theIndex m) then+ "Not enough resources availiable to process your request! Your request has been dropped! Please download the full version for free and run it on your own computer!"+ else+ (if not (failed uu) then "Conversion Running" else+ "Conversion Failed due to timeout or non zero exit code"))+ $+ do H.meta H.! A.httpEquiv "refresh" H.! A.content "1"+ H.table $+ do H.tr $+ do H.td $+ do H.progress H.! A.style wwidth H.!+ A.value (stringValue (show (prog)))+ H.! A.max "1000"+ $ ""+ Just _ -> do method GET+ ok $+ template "Conversion Finished" $+ pageFrame $+ infoBox "Conversion Finished" $+ do H.meta H.! A.httpEquiv "refresh" H.!+ A.content+ (stringValue+ ("0;url=/file/" +++ (show theIndex) ++ "." ++ (extension uu)))+ H.table $+ do H.tr $+ do H.td $+ do H.progress H.! A.style wwidth H.!+ A.value (stringValue (show (1000 :: Integer)))+ H.! A.max "1000"+ $ ""++fileFrame ::+ MVar (Map Int ProgressInfo) -> String -> ServerPart Response+fileFrame t sub+ = do let theIndex+ = case+ (reads (Data.List.takeWhile (/= '.') sub)) :: [(Int, String)] of+ ((k, _) : _) -> k+ _ -> 1+ m <- liftIO (takeMVar t)+ liftIO $ putMVar t m+ let uu+ = (fromMaybe progressInfoZero (Data.Map.Strict.lookup theIndex m))+ case filename uu of+ Just x -> do f <- serveFile (guessContentTypeM mimeTypes) x+ _ <- liftIO+ (forkIO+ (do threadDelay 2000000+ removeFile x))+ return f+ Nothing -> do method GET+ ok $+ template "Conversion Failed" $+ pageFrame $+ infoBox "Conversion Failed" $+ (mytext "We are sorry the converion failed, please contact our us")++currentlyrunning :: Map Int ProgressInfo -> Bool+currentlyrunning m+ = not+ (Data.List.all (\ x -> (isJust (filename x)) || (failed x))+ (Data.Map.Strict.elems m))++wwidth2 :: [Char]+wwidth2 = "width:400px"++wwidth :: AttributeValue+wwidth = stringValue wwidth2++formPage ::+ MVar (Map Int ProgressInfo) -> String -> ServerPart Response+formPage m s = do decodeBody (defaultBodyPolicy "/tmp/" 0 1000000 1000000) msum [viewForm, processForm]- where - viewForm :: ServerPart Response+ where viewForm :: ServerPart Response viewForm = do method GET ok $ template "MediaWiki2LaTeX" $- H.form H.! A.action "/form" H.! A.enctype "multipart/form-data" H.!- A.method "POST"- $- do H.label H.! A.for "msg" $- "Please enter the URL of any Wiki article that you'd like to convert to pdf. It may take a little while to process your request - but if you're patient, your pdf will be ready to go in less than 10 minutes. We apologize for this inconvenience: our test system is running on an old machine, only capable of providing an upstream with 300 KByte/s."- H.input H.! A.type_ "text" H.! A.id "msg" H.! A.name "msg"- H.input H.! A.type_ "submit" H.! A.value "Make PDF!"- + pageFrame $+ infoBox "Create Your PDF" $+ do mytext+ "To compile MediaWiki pages via LaTeX to PDF choose any URL from "+ H.a H.! A.href "http://en.wikipedia.org/" $ "Wikibooks"+ mytext+ " or any other website running MediaWiki. If you intent to compile a wikibook make sure you use the link to the printable version of the book."+ H.br+ H.div H.! A.style "font-size:20" $ H.b $ mytext "Send your request"+ H.form H.! A.action "/form" H.! A.enctype "multipart/form-data" H.!+ A.method "POST"+ $+ H.div $+ do H.table $+ do H.tr $+ do H.td "URL to the Wiki to be converted"+ H.td $+ do H.input H.! A.style wwidth H.! A.type_ "text" H.!+ A.id "msg"+ H.! A.name "msg"+ H.! A.value (stringValue s)+ H.tr $+ do H.td "Output Format"+ H.td $+ do H.select H.! A.style wwidth H.! A.name "output" $+ do H.option H.! A.value "pdf" $ "Compiled PDF"+ H.option H.! A.value "zip" $ "Source ZIP"+ H.option H.! A.value "epub" $ "EPUB File"+ H.option H.! A.value "odt" $+ "ODT File (Word Processor)"+ H.tr $+ do H.td "Template expansion"+ H.td $+ do H.select H.! A.style wwidth H.! A.name "expansion" $+ do H.option H.! A.value "Print" $ "Print"+ H.option H.! A.value "BookMode" $ "BookMode"+ H.option H.! A.value "MediaWiki" $ "Mediawiki"+ H.option H.! A.value "Normal" $ "Normal"+ H.tr $+ do H.td "Paper"+ H.td $+ do H.select H.! A.style wwidth H.! A.name "paper" $+ do H.option H.! A.value "A4" $ "A4"+ H.option H.! A.value "A5" $ "A5"+ H.option H.! A.value "B5" $ "B5"+ H.option H.! A.value "letter" $ "letter"+ H.option H.! A.value "legal" $ "legal"+ H.option H.! A.value "executive" $ "executive"+ H.tr $+ do H.td "Vector graphics"+ H.td $+ do H.select H.! A.style wwidth H.! A.name "vector" $+ do H.option H.! A.value "Rasterize" $ "Rasterize"+ H.option H.! A.value "Keep Vector Form" $+ "Keep Vector Form"+ H.tr $+ do H.td ""+ H.td $+ do H.input H.!+ A.style (stringValue (wwidth2 ++ ";height:60px"))+ H.! A.type_ "submit"+ H.! A.value "Start!"+ H.div H.! A.style "text-decoration:underline" $+ mytext "Please note:"+ H.br+ do mytext "The LaTeX source code will be compiled several times to make sure all references are resolved. The whole process will usually take about one minute." + H.br+ H.br+ H.div H.! A.style "font-size:large" $ H.b "There is a time limit of one hour (≈ 200 pages in PDF) on this server!"+ H.br+ mytext "Requests taking longer will be terminated and a \"Conversion Failed due to timeout or non zero exit code\" message will be displayed. There is no limit in the downloadable versions shown on the right." ++ getRunmode "Print" = ImperativeState.HTML+ getRunmode "MediaWiki" = ImperativeState.ExpandedTemplates+ getRunmode "Normal" = ImperativeState.StandardTemplates+ getRunmode "BookMode" = ImperativeState.Book+ getRunmode _ = ImperativeState.HTML+ processForm :: ServerPart Response processForm- = do method POST- msg <- lookBS "msg"- fileName <- liftIO $- do tmpDir <- getTemporaryDirectory- (name, handle) <- openTempFile tmpDir "MediaWiki2LaTeX.pdf"- hClose handle >> removeFile name- act <- mainAction (toString (toStrict msg)) name- _ <- system ("mediawiki2latex -x " ++ act)- return name- f <- serveFile (guessContentTypeM mimeTypes) fileName- _ <- liftIO- (forkIO- (do threadDelay 600000- removeFile fileName))- return f+ = do msg <- lookBS "msg"+ paperOpt <- lookBS "paper"+ vectorOpt <- lookBS "vector"+ expansion <- lookBS "expansion"+ output <- lookBS "output"+ zzz <- liftIO $+ do tmpDir <- getTemporaryDirectory+ (name, handle) <- openTempFile tmpDir+ ("MediaWiki2LaTeX" +++ if (toString (toStrict output)) == "zip" then+ "zip" else+ if (toString (toStrict output)) == "epub" then+ "epub" else+ if (toString (toStrict output)) == "odt" then+ "odt" else "pdf")+ hClose handle >> removeFile name+ act <- mainAction+ FullConfig{selfTest = Nothing, headers = Nothing,+ resolution = 300, outputFilename = name,+ inputUrl = (toString (toStrict msg)),+ runMode =+ if+ (isInfixOf ("Book:" :: [Char])+ (toString (toStrict msg)))+ then getRunmode ("BookMode" :: [Char]) else+ getRunmode (toString (toStrict expansion)),+ paper = (toString (toStrict paperOpt)),+ vector =+ (toString (toStrict vectorOpt)) ==+ "Keep Vector Form",+ ImperativeState.copy = Nothing, mainPath = "",+ server = Nothing,+ outputType =+ if (toString (toStrict output)) == "zip" then+ ImperativeState.ZipArchive else+ if (toString (toStrict output)) == "epub" then+ ImperativeState.EPubFile else+ if (toString (toStrict output)) == "odt" then+ ImperativeState.OdtFile else+ ImperativeState.PlainPDF,+ compile = Nothing, imgctrb = Nothing}+ yy <- newEmptyMVar+ mm <- takeMVar m+ _ <- if (not (currentlyrunning mm)) then+ do _ <- forkIO $+ do (i, o, e, h) <- runInteractiveCommand+ ("mediawiki2latex -x " ++ act)+ tt <- getPOSIXTime+ let ss+ = (if (toString (toStrict output)) == "zip"+ then "zip" else+ if (toString (toStrict output)) == "epub"+ then "epub" else+ if (toString (toStrict output)) == "odt"+ then "odt" else "pdf")+ zz <- forkProgressDriver o m name ss+ putMVar yy zz+ ex h i e ((realToFrac tt) + 3600.0) m zz ss+ return ()+ else+ do putMVar yy (-1)+ return ()+ putMVar m mm+ zzzz <- takeMVar yy+ return zzzz+ method POST+ ok $+ toResponse $+ template "Redirect" $+ do H.meta H.! A.httpEquiv "refresh" H.!+ A.content+ (stringValue+ ("0;url=/progress/" +++ (show zzz) +++ "." +++ (if (toString (toStrict output)) == "zip" then "html" else+ "html")))++ex ::+ ProcessHandle ->+ Handle ->+ Handle ->+ Double -> MVar (Map Int ProgressInfo) -> Int -> String -> IO ()+ex h i e t m n s+ = do tt <- getPOSIXTime+ threadDelay 100+ if (realToFrac tt) > t then+ do System.IO.hPutStr i "\n"+ mm <- takeMVar m+ putMVar m+ (Data.Map.Strict.update (\ x -> Just x{failed = True}) n mm)+ else return ()+ xi <- hIsOpen i+ if xi then hFlush i else return ()+ xo <- hIsOpen e+ _ <- if xo then System.IO.hGetContents e else return ""+ y <- getProcessExitCode h+ case y of+ Just ee -> if ExitSuccess == ee then+ do threadDelay 3000000+ mm <- takeMVar m+ putMVar m+ (Data.Map.Strict.insertWith+ (\ new old ->+ old{progress = progress new, lastStepTime = realToFrac tt})+ n+ progressInfoZero{progress = 1.0}+ mm)+ mmm <- takeMVar m+ putMVar m mmm+ case Data.Map.Strict.lookup n mmm of+ Just yy -> do _ <- takeMVar m+ putMVar m+ (Data.Map.Strict.insert n yy{filename = Just s} mmm)+ _ -> return ()+ else+ do mm <- takeMVar m+ putMVar m+ (Data.Map.Strict.update (\ x -> Just x{failed = True}) n mm)+ _ -> if (realToFrac tt) > t then return () else ex h i e t m n s++mylist :: [([Char], Double)]+mylist+ = [("downloading article and contributor information",+ 2.540431143798292e-2),+ ("parsing article text", 5.7625916241286344e-2),+ ("forking threads to download of images and contributor information on them",+ 5.8045207449988465e-2),+ ("precompiling table columns", 8.075814224942594e-2),+ ("joining threads to download the images and contributor information on them",+ 0.37003149457779727),+ ("preparing for PDF generation", 0.5479855803098518),+ ("preparing images for LaTeX document", 0.637605216120732),+ ("generating PDF file. LaTeX run 1 of 4", 0.6911489294291799),+ ("generating PDF file. LaTeX run 2 of 4", 0.7673758195622185),+ ("generating PDF file. LaTeX run 3 of 4", 0.8463397892914045),+ ("generating PDF file. LaTeX run 4 of 4", 0.9231746180088297),+ ("finished", 1.0)]++wwait :: Handle -> IO ()+wwait h+ = do b <- hIsEOF h+ if b then+ do threadDelay 1000+ wwait h+ else return ()++progressDriver ::+ Int -> Handle -> MVar (Map Int ProgressInfo) -> String -> IO ()+progressDriver n o t s+ = do xo <- hIsOpen o+ threadDelay 100+ tt <- getPOSIXTime+ l <- if xo then+ do wwait o+ hGetLine o+ else return ""+ case+ msum+ (Data.List.map+ (\ (k, v) -> if isInfixOf k l then Just v else Nothing)+ mylist)+ of+ Just x -> do m <- takeMVar t+ putMVar t+ (Data.Map.Strict.insertWith+ (\ new old ->+ old{progress = progress new, lastStepTime = realToFrac tt})+ n+ progressInfoZero{progress = x}+ m)+ _ -> return ()+ m <- readMVar t+ case Data.Map.Strict.lookup n m of+ Just yy | (progress yy) == 1.0 ->+ do _ <- takeMVar t+ putMVar t (Data.Map.Strict.insert n yy{filename = Just s} m)+ Just yy | (failed yy) -> return ()+ _ -> progressDriver n o t s++progressInfoZero :: ProgressInfo+progressInfoZero+ = ProgressInfo{progress = 0.0, filename = Nothing, startTime = 0.0,+ failed = False, barValue = 0.0, lastStepTime = 0.0,+ lastRuntime = 0.0, extension = ""}++forkProgressDriver ::+ Handle -> MVar (Map Int ProgressInfo) -> String -> String -> IO Int+forkProgressDriver o t s ext+ = do m <- takeMVar t+ tt <- getPOSIXTime+ let mm+ = case (keys m) of+ (x : xs) -> Data.List.maximum (x : xs)+ _ -> 0+ putMVar t+ (Data.Map.Strict.insert (mm + 1)+ ProgressInfo{progress = 0.0, filename = Nothing,+ startTime = realToFrac tt, barValue = 0.0, lastStepTime = 0.0,+ lastRuntime = 0.0, extension = ext, failed = False}+ m)+ _ <- forkIO (progressDriver (mm + 1) o t s)+ return (mm + 1)
src/SimpleContributors.hs view
@@ -1,6 +1,5 @@-+{-| module to load information on the contributors in images from the wiki website -} module SimpleContributors where-import Compiler import MediaWikiParseTree import MediaWikiParser import LatexRenderer@@ -18,18 +17,19 @@ import Control.Monad import Licenses import Tools- +import ImperativeState+ makeUrl2 :: String -> String -> [Char] makeUrl2 theLemma theHost = (unify . exportURL) (URL{url_path = "w/index.php", url_params =- [("title", theLemma), ("offset", ""), ("limit", "500000"),- ("action", "history")],+ [("title", (replace2 theLemma "%" "%25")), ("offset", ""),+ ("limit", "500000"), ("action", "history")], url_type = Absolute- (Host{protocol = HTTP False, host = theHost, port = Nothing})})- + (Host{protocol = HTTP True, host = theHost, port = Nothing})})+ makeUrl4 :: String -> [Char] makeUrl4 uuu = fromMaybe uuu@@ -39,18 +39,18 @@ (unify . exportURL) (URL{url_path = (url_path uu), url_params =- [("title", ti), ("offset", ""), ("limit", "500000"),- ("action", "history")],+ [("title", (replace2 ti "%" "%25")), ("offset", ""),+ ("limit", "500000"), ("action", "history")], url_type = url_type uu}))- + makeUrl3 :: String -> String -> [Char] makeUrl3 theLemma theHost = (unify . exportURL) (URL{url_path = "w/index.php", url_params = [("title", theLemma)], url_type = Absolute- (Host{protocol = HTTP False, host = theHost, port = Nothing})})- + (Host{protocol = HTTP True, host = theHost, port = Nothing})})+ deepGet2 :: [Char] -> [Anything a] -> [Anything a] deepGet2 tag ll = concat $ map go ll where go (Environment Tag (TagAttr t m) l)@@ -58,17 +58,16 @@ [Environment Tag (TagAttr tag m) l] ++ (deepGet2 tag l) go (Environment _ _ l) = (deepGet2 tag l) go _ = []- + getLicense :: [Anything Char] -> Maybe [Char] getLicense l = (go l)- where - go :: [Anything Char] -> Maybe String+ where go :: [Anything Char] -> Maybe String go ll = msum (map (dg ll) licenses) dg ll (x, c) = case deepGet "a" "href" x ll of (_ : _) -> Just c _ -> Nothing- + getAuthor :: [Anything Char] -> Maybe [Anything Char] getAuthor x = listToMaybe (concat (map go (deepGet2 "tr" x))) where go (Environment _ _ l)@@ -79,11 +78,13 @@ _ -> [] _ -> [] go _ = []- + simpleContributors :: [Char] ->- [Char] -> Maybe URL -> IO [(String, String, Int, Maybe String)]-simpleContributors theLemma theHost uu+ [Char] ->+ Maybe URL ->+ ImperativeState -> IO [(String, String, Int, Maybe String)]+simpleContributors theLemma theHost uu st = do let theUrl3 = case uu of Just u -> exportURL u@@ -101,7 +102,7 @@ mm of (Just- x) -> "http://"+ x) -> "https://" ++ theHost ++@@ -116,65 +117,68 @@ let y = decodeString yy let x = decodeString xx let dd- = (deepGet "a" "class" "mw-userlink" (parseit minparsers x)) ::- [Anything Char]+ = ((deepGet "a" "class" "new mw-userlink" (parseit minparsers x))+ ++ (deepGet "a" "class" "mw-userlink" (parseit minparsers x)))+ :: [Anything Char] let ll = (filter pre (map go dd)) let n = (nub ll) :: [(String, String)] let out = map go2 (zip (map (count ll) n) n) let ht = (parseit htmlminparsers y) case (getAuthor ht) of Just zz -> return- [(fst (treeToLaTeX3 zz initialState), "", 1 :: Int, getLicense ht)]+ [(fst+ (treeToLaTeX3 zz+ initialState{urld = analyseNetloc (hostname . fullUrl $ st)}),+ "", 1 :: Int, getLicense ht)] _ -> return out- where - go :: Anything Char -> (String, String)+ where go :: Anything Char -> (String, String) go (Environment Tag (TagAttr _ m) l)- = ((shallowFlatten l), findWithDefault "" "href" m)+ = ((shallowFlatten (deepFlatten l)), findWithDefault "" "href" m) go _ = ("", "") go2 (c, (a, h)) = (a, h, c, Nothing)- + count :: (Eq a) => [a] -> a -> Int count l s = length (filter (== s) l)- + pre :: (String, String) -> Bool pre s = case (runParser ipaddr () "" (fst s)) of Right _ -> False Left _ -> True- + intdigit :: Parser Int intdigit = do a <- digit case reads [a] of [(i, [])] -> return i _ -> pzero- + ipnum3 :: ParsecT String () Identity Int ipnum3 = do a <- intdigit b <- intdigit c <- intdigit return (a * 100 + b * 10 + c)- + ipnum2 :: ParsecT String () Identity Int ipnum2 = do a <- intdigit b <- intdigit return (a * 10 + b)- + ipnum1 :: Parser Int ipnum1 = do intdigit- + ipnum :: ParsecT [Char] () Identity () ipnum = do n <- (try (ipnum3)) <|> (try (ipnum2)) <|> ipnum1 if ((n <= 255) && (n >= 0)) then return () else pzero- + ipaddr :: Text.Parsec.Prim.ParsecT [Char] () Data.Functor.Identity.Identity () ipaddr = try (ipv4addr) <|> ipv6addr- + ipv4addr :: Text.Parsec.Prim.ParsecT [Char] () Data.Functor.Identity.Identity ()@@ -187,7 +191,7 @@ _ <- char '.' _ <- ipnum return ()- + ipv6num :: Text.Parsec.Prim.ParsecT [Char] () Data.Functor.Identity.Identity ()@@ -198,7 +202,7 @@ _ <- try (hexDigit) <|> return '0' _ <- try (hexDigit) <|> return '0' return ()- + ipv6addr :: Text.Parsec.Prim.ParsecT [Char] () Data.Functor.Identity.Identity ()
src/Static.hs view
@@ -1,52 +1,83 @@ {-# LANGUAGE TemplateHaskell #-}+{-| latex and config files embedded into the binary application . -} module Static where import Data.FileEmbed import Data.ByteString-import System.Directory import Data.ByteString.UTF8+import System.Directory+import System.FilePath++--{-| webImage -} +--mainImage :: [(FilePath, ByteString)]+--mainImage = $(embedFile "src/mainImage.png")++ +{-| needed LaTeX Headers -}+ headerFiles :: [(FilePath, ByteString)] headerFiles = $(embedDir "./document/headers") +{-| language configuration file of mediawiki2latex -}+ babelFiles :: [(FilePath, ByteString)] babelFiles = $(embedDir "./src/babel") +{-| function to create the necessary directories for the LaTeX tree in the temporary directory. The pathname of the temporary directory has to be supplied as first parameter -}+ createDirectories :: String -> IO [()] createDirectories pathname = mapM (\ s -> (createDirectoryIfMissing True (pathname ++ "/document/" ++ s)))- ["images", "headers", "main"]+ ["images", "headers", "main", "formulas"] +{-| function to write files to an already created directory in the temporary directory. The first parameter is the pathname of the temporary directory. The second parameter is a list tuples. The first element of each tuple is the relative pathname of the file to be created. The second element of each tuple is the binary data to be written into the file -}+ writeFiles :: String -> [(FilePath, Data.ByteString.ByteString)] -> IO () writeFiles pathname filelist = do _ <- (mapM (\ (name, content) ->- Data.ByteString.writeFile (pathname ++ name) content)+ Data.ByteString.writeFile (pathname </> name) content) filelist) return () +{-| the header of the main latex file -}+ latexHeader :: ByteString latexHeader = $(embedFile "./latex/my-head.tex") +{-| the footer of the main latex file -}+ latexFooter :: ByteString latexFooter = $(embedFile "./latex/my-tail.tex") +{-| the preamble of the list of figures in the main latex file -}+ latexPreamble :: ByteString latexPreamble = $(embedFile "./latex/preamble.tex") +{-| the header for a latex file which contains only a single comlumn of a table. This header is used when precompiling latex table columns in order to calculate optimized column widths for each table automaticaly -}+ latexTableHeader :: ByteString latexTableHeader = $(embedFile "./latex/my-tabhead.tex") +{-| the header for a latex file which contains only a single comlumn of a table. This header is used when precompiling latex table columns in order to calculate optimized column widths for each table automaticaly -}+ latexTableFooter :: ByteString latexTableFooter = $(embedFile "./latex/my-tabtail.tex") +{-| the templates.user file. This file contains a mapping of mediawikis templates to latex commands. This is the default file. It is used when suppliing the -i command line option. The user may override it with the -t command line option. This file contains a list of lists in Haskell notaion. Each sublists contains strings. The first string in each sublist is the name of the template as it is used in the wiki notation, the second string is the name of the latex command to be called. The following strings are the names of the parameters in wiki notation which should be passed to the latex command in the order they are denoted. -}+ userTemplates :: String userTemplates = toString $(embedFile "./latex/templates.user") +{-| a function to write all files that are embedded into the binary application which are needed for the LaTeX tree in the temporary directory to disk. The first parameter is the name of the temporary directory in which the latex tree which the necessary files shall be created. -}+ extract :: String -> IO () extract pathname = do _ <- createDirectories pathname writeFiles (pathname ++ "/document/headers/") headerFiles+
src/TableHelper.hs view
@@ -1,17 +1,17 @@-{-DHUN| helper functions to convert tables from the parse tree notation to the latex notation DHUN-}+{-| helper functions to convert tables from the parse tree notation to the latex notation -} module TableHelper where import MediaWikiParseTree import Tools import Text.Printf import Data.Char import qualified Data.Map as Map-import Data.Map (Map)+import Data.Map.Strict (Map) import Data.Maybe import Control.Monad import MyState- -{-DHUN| the width of a columns as float wrapped in a Just value of the maybe monad if it could be determined. Return the value Nothing of the maybe monad otherwise. The only parameter is of part of the parse tree that describe the opening part of the table cell element. DHUN-}- ++{-| the width of a columns as float wrapped in a Just value of the maybe monad if it could be determined. Return the value Nothing of the maybe monad otherwise. The only parameter is of part of the parse tree that describe the opening part of the table cell element. -}+ widthOfColumn :: [Anything Char] -> Maybe Float widthOfColumn = msum . (map f) where f (Environment Attribute (Attr (k, v)) _)@@ -21,13 +21,13 @@ guard ('%' `elem` v) return (1.0e-2 * z) f _ = Nothing- + columnMultiplicityForSimple :: [Anything Char] -> Int columnMultiplicityForSimple x = case columnMultiplicity x of Just a -> a _ -> -1- + raggedArrayOfWidths :: [Anything Char] -> [Maybe Float] -> [[Maybe Float]] raggedArrayOfWidths ((Environment TableRowSep _ _) : xs) temp@@ -47,14 +47,14 @@ (replicate ((columnMultiplicityForSimple x) - 1) [Nothing])))) raggedArrayOfWidths (_ : xs) temp = (raggedArrayOfWidths xs temp) raggedArrayOfWidths [] temp = [temp]- + numberOfColumns :: [Anything Char] -> Int numberOfColumns a = (maximum ([length x | x <- (raggedArrayOfWidths a [])]))- + initialListofWidths :: [Anything Char] -> [Maybe Float] initialListofWidths x = replicate (numberOfColumns x) Nothing- + listMax :: [Maybe Float] -> [Maybe Float] -> [Maybe Float] listMax (Just x : xs) (Just y : ys) = Just (max x y) : listMax xs ys@@ -62,11 +62,11 @@ listMax [] (y : ys) = y : listMax [] ys listMax (x : xs) [] = x : listMax xs [] listMax [] [] = []- + preliminaryWidths :: [[Maybe Float]] -> [Maybe Float] -> [Maybe Float] preliminaryWidths l k = foldl (listMax) k l- + standardColumnWitdh :: [Anything Char] -> Maybe Float standardColumnWitdh a = if columns > columnsWithDefinedWidth then@@ -79,14 +79,14 @@ columns = numberOfColumns a columnsWithDefinedWidth = length (filter isJust l) sumOfDefinedWidths = sum (map fromJust (filter isJust l))- + rawWidths :: [Anything Char] -> [Maybe Float] rawWidths a = (preliminaryWidths (raggedArrayOfWidths a []) (initialListofWidths a))- -{-DHUN fallback function for the width of columns if the precompilation procedure for the width of columns is not available yet. So particularly when the precompilation is just running. Takes the parse tree representation of the table as first input parameter. Returns the list of widths of the columns. I am not documenting its subfunctions since the final width of the columns don't have anything to do with the width calculated here, still these preliminary widths are needed for the precompilation procedure DHUN-}- ++{- fallback function for the width of columns if the precompilation procedure for the width of columns is not available yet. So particularly when the precompilation is just running. Takes the parse tree representation of the table as first input parameter. Returns the list of widths of the columns. I am not documenting its subfunctions since the final width of the columns don't have anything to do with the width calculated here, still these preliminary widths are needed for the precompilation procedure -}+ columnWidths :: [Anything Char] -> [Float] columnWidths a = w where l = rawWidths a@@ -96,65 +96,65 @@ w = fromMaybe (concat (replicate m [f / mf])) $ do ww <- standardColumnWitdh a return [x * f | x <- map (fromMaybe ww) l]- -{-DHUN| part of the correction calculation for the space between columns inside a table. Takes the number of columns as first input parameter returns a scaling factor DHUN-}- ++{-| part of the correction calculation for the space between columns inside a table. Takes the number of columns as first input parameter returns a scaling factor -}+ scalefactor :: (Fractional a, Ord a) => a -> a-scalefactor n | n <= 10 = 18.0 * (n) / 448.0+scalefactor n | n <= 10 = 12.8 * (n) / 448.0 scalefactor _ = 12.8 * (11.0) / 448.0- -{-DHUN| part of the correction calculation for the space between columns inside a table. Takes the number of columns as first input parameter returns a scaling factor DHUN-}- ++{-| part of the correction calculation for the space between columns inside a table. Takes the number of columns as first input parameter returns a scaling factor -}+ tableScale :: Int -> Float tableScale nColumns = (1.0 / n) * (1.0 - (scalefactor n)) where n = fromIntegral nColumns- -{-DHUN| returns the latex environment name for a table environments. It the float passes as first parameter it 1.0 the result is longtable, otherwise it is tabular. This function is usually called with the width of the current cell in units of the line width as first parameter. Outside any table this value is 1.0 inside a table it is always smaller than 1.0. So this function will return tabular in case of a nested table, which is necessary since longtables can not be nested inside other longtables, but tabulars can be nested within longtables as well as tabulars. DHUN-}- ++{-| returns the latex environment name for a table environments. It the float passes as first parameter it 1.0 the result is longtable, otherwise it is tabular. This function is usually called with the width of the current cell in units of the line width as first parameter. Outside any table this value is 1.0 inside a table it is always smaller than 1.0. So this function will return tabular in case of a nested table, which is necessary since longtables can not be nested inside other longtables, but tabulars can be nested within longtables as well as tabulars. -}+ tableEnvironment :: Float -> String tableEnvironment 1.0 = "longtable" tableEnvironment _ = "tabular"- + innerTableSpecifier :: [Float] -> String -> String innerTableSpecifier (f : xs) t = ">{\\RaggedRight}p{" ++ (printf "%0.5f" f) ++ "\\linewidth}" ++ t ++ (innerTableSpecifier xs t) innerTableSpecifier [] _ = []- -{-DHUN| Returns the table header which represents the width of the columns of a table in units of the line width. It takes a list of width as second parameter. It is understood that necessary correction for the width to compensate for the space needed by separations of columns have already been applied. The is the first boolean parameter is true rules will be drawn in the table, otherwise they won't. See also documentation of the wdth3 function in the module LatexRenderer. DHUN-}- ++{-| Returns the table header which represents the width of the columns of a table in units of the line width. It takes a list of width as second parameter. It is understood that necessary correction for the width to compensate for the space needed by separations of columns have already been applied. The is the first boolean parameter is true rules will be drawn in the table, otherwise they won't. See also documentation of the wdth3 function in the module LatexRenderer. -}+ tableSpecifier :: Bool -> [Float] -> String tableSpecifier True f = '|' : (innerTableSpecifier f "|") tableSpecifier False f = (innerTableSpecifier f "")- -{-DHUN| Takes the multirowmap as first input parameter. See documentation on the function multiRowDictChangeStart in this module for details on the multirowmap. It returns true if there are currently no multirow cells active in the given multirowdict DHUN-}- ++{-| Takes the multirowmap as first input parameter. See documentation on the function multiRowDictChangeStart in this module for details on the multirowmap. It returns true if there are currently no multirow cells active in the given multirowdict -}+ myempty :: Map Int (Int, Int) -> Bool myempty d = [x | x <- Map.toList d, (fst (snd x)) /= 0] == []- -{-DHUN| takes the string found in the header symbol of a table or the opening tag of the html table tag. That is the place where the attributes are, but only understood as string so without parsing the attributes as map, and returns a boolean. It this boolean is true the rules of the table need to be drawn, otherwise they must not be drawn DHUN-}- ++{-| takes the string found in the header symbol of a table or the opening tag of the html table tag. That is the place where the attributes are, but only understood as string so without parsing the attributes as map, and returns a boolean. It this boolean is true the rules of the table need to be drawn, otherwise they must not be drawn -}+ seperatingLinesRequested :: String -> Bool seperatingLinesRequested s = (isInfixOf2 "Prettytable" (map toLower s)) || (isInfixOf2 "prettytable" (map toLower s)) || (isInfixOf2 "wikitable" (map toLower s))- -{-DHUN| returns the latex symbol for a horizontal line on the last row of a table, that is a horizontal rule, if the first boolean parameter is true, otherwise the empty string is returned. This function is usually being called with the first parameter indicating whether or not rules should be drawn with the table DHUN-}- ++{-| returns the latex symbol for a horizontal line on the last row of a table, that is a horizontal rule, if the first boolean parameter is true, otherwise the empty string is returned. This function is usually being called with the first parameter indicating whether or not rules should be drawn with the table -}+ rowDelimiter :: Bool -> String rowDelimiter True = "\\\\ \\hline" rowDelimiter False = ""- -{-DHUN| returns the latex symbol for a horizontal line in a table, that is a horizontal rule, if the first boolean parameter is true, otherwise the empty string is returned. This function is usually being called with the first parameter indicating whether or not rules should be drawn with the table DHUN-}- ++{-| returns the latex symbol for a horizontal line in a table, that is a horizontal rule, if the first boolean parameter is true, otherwise the empty string is returned. This function is usually being called with the first parameter indicating whether or not rules should be drawn with the table -}+ horizontalLine :: Bool -> String horizontalLine True = " \\hline" horizontalLine False = ""- -{-DHUN| return the latex symbol for a partly drawn inner horizontal line in a table, that is a horizontal rule. It has to be drawn only partly since multirow cells intersect with it. The second parameter is the multirowmap (the documentation on the function multiRowDictChangeStart in this module for details). The third parameter is the total number of columns in the table. The first parameter is a and index that is incremented during the course of this function and has to be 1 when called this function from outside DHUN-}- ++{-| return the latex symbol for a partly drawn inner horizontal line in a table, that is a horizontal rule. It has to be drawn only partly since multirow cells intersect with it. The second parameter is the multirowmap (the documentation on the function multiRowDictChangeStart in this module for details). The third parameter is the total number of columns in the table. The first parameter is a and index that is incremented during the course of this function and has to be 1 when called this function from outside -}+ makeCLines :: Int -> Map Int (Int, Int) -> Int -> [Char] makeCLines m d t = if m <= t then@@ -166,23 +166,23 @@ where def = "\\cline{" ++ (show m) ++ "-" ++ (show m) ++ "}" ++ (makeCLines (m + 1) d t)- -{-DHUN| return the latex symbol for an inner horizontal line in a table, that is a horizontal rule. If the first boolean parameter is true the rule is drawn otherwise it is not. If multirow cells interfere with this rule the rule is only drawn in parts as required. The second parameter is the multirowmap (the documentation on the function multiRowDictChangeStart in this module for details). The third parameter is the total number of columns in the table DHUN-}- ++{-| return the latex symbol for an inner horizontal line in a table, that is a horizontal rule. If the first boolean parameter is true the rule is drawn otherwise it is not. If multirow cells interfere with this rule the rule is only drawn in parts as required. The second parameter is the multirowmap (the documentation on the function multiRowDictChangeStart in this module for details). The third parameter is the total number of columns in the table -}+ innerHorizontalLine :: Bool -> Map Int (Int, Int) -> Int -> String innerHorizontalLine b d m = if b then if myempty d then horizontalLine True else ' ' : makeCLines 1 d m else ""- -{-DHUN| the symbol in latex for separating columns. It is returned if the fist boolean parameter is true otherwise the empty string is returned. This function is usually called with the first parameter being true if the current column was not the first column of a row since the symbol is not needed before the start of the first column of a row. This is a contrast to html where the first cell of a row has its own td or th tag. The mediawiki markup notation is similar to html in this respect. DHUN-}- ++{-| the symbol in latex for separating columns. It is returned if the fist boolean parameter is true otherwise the empty string is returned. This function is usually called with the first parameter being true if the current column was not the first column of a row since the symbol is not needed before the start of the first column of a row. This is a contrast to html where the first cell of a row has its own td or th tag. The mediawiki markup notation is similar to html in this respect. -}+ columnSeperator :: Bool -> String columnSeperator True = "&" columnSeperator False = ""- -{-DHUN| takes the parse result of the attributes of a th tag or td tag or a corresponding header column separator or column separator as second parameter. It takes a key for this map of attributes as string as first parameter. If the key is present in the map, and the value found in the map at that key can be parsed as an Integer that integer is returned. If no value for the key could be found in the map or it could not be parsed as an integer the value Nothing of the Maybe monad is returned. DHUN-}- ++{-| takes the parse result of the attributes of a th tag or td tag or a corresponding header column separator or column separator as second parameter. It takes a key for this map of attributes as string as first parameter. If the key is present in the map, and the value found in the map at that key can be parsed as an Integer that integer is returned. If no value for the key could be found in the map or it could not be parsed as an integer the value Nothing of the Maybe monad is returned. -}+ genMultiplicity :: String -> [Anything Char] -> Maybe Int genMultiplicity s = msum . (map f) where f (Environment Attribute (Attr (k, v)) _)@@ -191,9 +191,9 @@ guard (k == s) return z f _ = Nothing- -{-DHUN| takes the parse result of the attributes of a th tag or td tag or a corresponding header column separator or column separator as second parameter. It takes a key for this map of attributes as string as first parameter. It returns a result of the lookup of the key in the map (so the value). as string wrapped into the Maybe monad. If no value for the key could be found in the map it returns the value Nothing of the Maybe monad. DHUN-}- ++{-| takes the parse result of the attributes of a th tag or td tag or a corresponding header column separator or column separator as second parameter. It takes a key for this map of attributes as string as first parameter. It returns a result of the lookup of the key in the map (so the value). as string wrapped into the Maybe monad. If no value for the key could be found in the map it returns the value Nothing of the Maybe monad. -}+ genLookup :: String -> [Anything Char] -> Maybe String genLookup s = msum . (map f) where f (Environment Attribute (Attr (k, v)) _)@@ -202,24 +202,24 @@ guard (k == s) return v f _ = Nothing- -{-DHUN| the column multiplicity of the current cell. The first parameter is the parse result of the inner part of the column separator of header column separator, that corresponds to the attributes of the th or td html elements. The result is an integer wrapped into the maybe monad. The value Nothing of the Maybe monad is returned if the attribute colspan is not present (or did not have a value parseable as Integer) within the first parameter DHUN-}- ++{-| the column multiplicity of the current cell. The first parameter is the parse result of the inner part of the column separator of header column separator, that corresponds to the attributes of the th or td html elements. The result is an integer wrapped into the maybe monad. The value Nothing of the Maybe monad is returned if the attribute colspan is not present (or did not have a value parseable as Integer) within the first parameter -}+ columnMultiplicity :: [Anything Char] -> Maybe Int columnMultiplicity = genMultiplicity "colspan"- -{-DHUN| the row multiplicity of the current cell. The first parameter is the parse result of the inner part of the column separator of header column separator, that corresponds to the attributes of the th or td html elements. The result is an integer wrapped into the maybe monad. The value Nothing of the Maybe monad is returned if the attribute rowspan is not present (or did not have a value parseable as Integer) within the first parameter DHUN-}- ++{-| the row multiplicity of the current cell. The first parameter is the parse result of the inner part of the column separator of header column separator, that corresponds to the attributes of the th or td html elements. The result is an integer wrapped into the maybe monad. The value Nothing of the Maybe monad is returned if the attribute rowspan is not present (or did not have a value parseable as Integer) within the first parameter -}+ rowMultiplicity :: [Anything Char] -> Maybe Int rowMultiplicity = genMultiplicity "rowspan"- -{-DHUN| the column multiplicity of the current cell. The first parameter is the parse result of the inner part of the column separator of header column separator, that corresponds to the attributes of the th or td html elements.The result is an integer that default to zero DHUN-}- ++{-| the column multiplicity of the current cell. The first parameter is the parse result of the inner part of the column separator of header column separator, that corresponds to the attributes of the th or td html elements.The result is an integer that default to zero -}+ columnMultiplicityForCounting :: [Anything Char] -> Int columnMultiplicityForCounting = (fromMaybe 1) . columnMultiplicity- -{-DHUN| return the symbol for the start of a multicolumn cell in latex. The first parameter is the parse result of the inner part of the column separator of header column separator, that corresponds to the attributes of the th or td html elements. It takes the list of the final widths of all columns of the table as second parameter. It takes to the column index of the current column as third parameter. The fourth parameter is a boolean if it is true rules will be drawn in the table otherwise they won't. The fifth parameter is the table state. That is the mutable state that exists during rendering of a table. DHUN-}- ++{-| return the symbol for the start of a multicolumn cell in latex. The first parameter is the parse result of the inner part of the column separator of header column separator, that corresponds to the attributes of the th or td html elements. It takes the list of the final widths of all columns of the table as second parameter. It takes to the column index of the current column as third parameter. The fourth parameter is a boolean if it is true rules will be drawn in the table otherwise they won't. The fifth parameter is the table state. That is the mutable state that exists during rendering of a table. -}+ multiColumnStartSymbol :: [Anything Char] -> [Float] -> Int -> Bool -> TableState -> String multiColumnStartSymbol l f i t st@@ -232,23 +232,23 @@ _ -> "l" mylist nn = [min 1.0- ((1.0 - (scalefactor 1.0)) * (sum (take nn (drop (i - 1) f))))- / (1.0 - (scalefactor (fromIntegral nn)))]- -{-DHUN| return the symbol for the end of a multicolumn cell in latex. The first boolean parameter tells if the cell is actually a multicolumn cell. If it is false the empty string is returned instead DHUN-}- + (((1.0 - (scalefactor 1)) * (sum (take nn (drop (i - 1) f)))) /+ (1.0 - (scalefactor (fromIntegral nn))))]++{-| return the symbol for the end of a multicolumn cell in latex. The first boolean parameter tells if the cell is actually a multicolumn cell. If it is false the empty string is returned instead -}+ multiColumnEndSymbol :: Bool -> String multiColumnEndSymbol True = "}" multiColumnEndSymbol False = ""- -{-DHUN| return the symbol for the end of a multirow cell in latex. The first boolean parameter tells if the cell is actually a multirow cell. If it is false the empty string is returned instead DHUN-}- ++{-| return the symbol for the end of a multirow cell in latex. The first boolean parameter tells if the cell is actually a multirow cell. If it is false the empty string is returned instead -}+ multiRowEndSymbol :: Bool -> String multiRowEndSymbol True = "}" multiRowEndSymbol False = ""- -{-DHUN| This function takes a default value as first parameter. It takes a predicate as second parameter. It take a map from Int to a two tuple of Int as firth parameter. It takes a key for that map as fourth parameter. It takes a function mapping a two tuple of Int to the same type as the default value as third parameter. It tries to find a two tuple of Ints (that is value) in the map under the given key. If it finds one and the predicate returns true on the first element of that two tuple it returns the result of the function on the two tuple. In any other case it returns the default value DHUN-}- ++{-| This function takes a default value as first parameter. It takes a predicate as second parameter. It take a map from Int to a two tuple of Int as firth parameter. It takes a key for that map as fourth parameter. It takes a function mapping a two tuple of Int to the same type as the default value as third parameter. It tries to find a two tuple of Ints (that is value) in the map under the given key. If it finds one and the predicate returns true on the first element of that two tuple it returns the result of the function on the two tuple. In any other case it returns the default value -}+ withDefault :: t -> (Int -> Bool) ->@@ -258,15 +258,15 @@ do (a, b) <- Map.lookup i d guard $ p a return $ f a b- -{-DHUN| this function return the vertical separator for column for the table header in latex. The only parameter is a boolean. If it is true rules will be drawn in the table, otherwise they won't DHUN-}- ++{-| this function return the vertical separator for column for the table header in latex. The only parameter is a boolean. If it is true rules will be drawn in the table, otherwise they won't -}+ verticalSeperator :: Bool -> [Char] verticalSeperator True = "|" verticalSeperator False = ""- -{-DHUN| the function returns the a string to be inserted into a latex document for multirows at a when a new column (that is a new cell) starts, thats when a column separator, or header column separator is encountered. The first parameter it the index of the current column. The second parameter is the multirowdict (see documentation of the multiRowDictChangeStart function in this module). The third parameter is a boolean. If it is true rules will be drawn in the table, otherwise they won't DHUN-}- ++{-| the function returns the a string to be inserted into a latex document for multirows at a when a new column (that is a new cell) starts, thats when a column separator, or header column separator is encountered. The first parameter it the index of the current column. The second parameter is the multirowdict (see documentation of the multiRowDictChangeStart function in this module). The third parameter is a boolean. If it is true rules will be drawn in the table, otherwise they won't -}+ multiRowSymbol :: Int -> Map Int (Int, Int) -> Bool -> String multiRowSymbol i d t = withDefault "" (> 0)@@ -279,9 +279,9 @@ (verticalSeperator t) ++ "}{}&" ++ (multiRowSymbol (i + b) d t)) i d- -{-DHUN| the function returns the a string to be inserted into a latex document for multirows at a when a new row starts, thats when a row separator is encountered. The first parameter it the index of the current column. The second parameter is the multirowdict (see documentation of the multiRowDictChangeStart function in this module). The third parameter is a boolean. If it is true rules will be drawn in the table, otherwise they won't DHUN-}- ++{-| the function returns the a string to be inserted into a latex document for multirows at a when a new row starts, thats when a row separator is encountered. The first parameter it the index of the current column. The second parameter is the multirowdict (see documentation of the multiRowDictChangeStart function in this module). The third parameter is a boolean. If it is true rules will be drawn in the table, otherwise they won't -}+ multiRowSymbolForRowSep :: Int -> Map Int (Int, Int) -> Bool -> String multiRowSymbolForRowSep i d t@@ -296,9 +296,9 @@ "}{}" ++ (multiRowSymbolForRowSep (i + b) d) t) i d- -{-DHUN| the function returns the a string to be inserted into a latex document for multirows at the end of the table. The first parameter it the index of the current column. The second parameter is the multirowdict (see documentation of the multiRowDictChangeStart function in this module). The third parameter is a boolean. If it is true rules will be drawn in the table, otherwise they won't DHUN-}- ++{-| the function returns the a string to be inserted into a latex document for multirows at the end of the table. The first parameter it the index of the current column. The second parameter is the multirowdict (see documentation of the multiRowDictChangeStart function in this module). The third parameter is a boolean. If it is true rules will be drawn in the table, otherwise they won't -}+ multiRowSymbolForTableEnd :: Int -> Map Int (Int, Int) -> Bool -> String multiRowSymbolForTableEnd i d t@@ -313,15 +313,15 @@ "}{}" ++ (multiRowSymbolForTableEnd (i + 1) d t)) i d- -{-DHUN| in case of a multirow, that cell has to be skipped further down. So if I got a multirow in row 1 column 2 with a rowspan of 2 or more I need to expand row 2 column 1 by 1 . So if I passed row 2 column one I am not in row 2 column 2 since that is where the multirow cell resides, I am rather in row 2 cell 3. And if there are more multicolumns involved I am more possible even further right. So this function just tell me how many cells I have to skip. The first parameter is the index of the current column. The second parameter is the multirowdict. See also documentation on the function multiRowDictChangeStart in this module DHUN-}- ++{-| in case of a multirow, that cell has to be skipped further down. So if I got a multirow in row 1 column 2 with a rowspan of 2 or more I need to expand row 2 column 1 by 1 . So if I passed row 2 column one I am not in row 2 column 2 since that is where the multirow cell resides, I am rather in row 2 cell 3. And if there are more multicolumns involved I am more possible even further right. So this function just tell me how many cells I have to skip. The first parameter is the index of the current column. The second parameter is the multirowdict. See also documentation on the function multiRowDictChangeStart in this module -}+ multiRowCount :: Int -> Map Int (Int, Int) -> Int multiRowCount i d = withDefault 0 (/= 0) (\ _ b -> b + (multiRowCount (i + 1) d)) i d- -{-DHUN| see documentation on multiRowDictChangeStart. This function take the index of the current column as first parameter. This function takes the multiRowDict as first parameter and returns the modified version of it. DHUN-}- ++{-| see documentation on multiRowDictChangeStart. This function take the index of the current column as first parameter. This function takes the multiRowDict as first parameter and returns the modified version of it. -}+ multiRowDictChangeEnd :: Int -> Map Int (Int, Int) -> Map Int (Int, Int) multiRowDictChangeEnd i d@@ -330,9 +330,9 @@ multiRowDictChangeEnd (i + 1) (Map.insert i (a - 1, b) d)) i d- -{-DHUN| The multiRowDict is a facility for keeping track of cells spanning multiple rows. It is stored as mutable state in the type TableState in the parameter multiRowMap. It is passed to this function as second parameter. This function return an updated version of it. It is a map mapping and Int to a tuple whose both elements are also ints. It the key is the column index and the value is a pair (rowmultiplicity, columnmultiplicity). The rowmultiplicity is the number of rows the cell spans. This number is decrease every time a row ends. So it actually says how many rows the columns spans further down from the current column. The column multiplicity is the number of columns the cell spans. This function take the index of the current column as first parameter. This function takes the parse result of the opening part of the cell environment of the current cell as third input parameter. This function calculates only the changes in the multirowdict for the opening environment of the cell. You should not use this function but rather use multiRowDictChange since this also considers the effect by ending of cells DHUN-}- ++{-| The multiRowDict is a facility for keeping track of cells spanning multiple rows. It is stored as mutable state in the type TableState in the parameter multiRowMap. It is passed to this function as second parameter. This function return an updated version of it. It is a map mapping and Int to a tuple whose both elements are also ints. It the key is the column index and the value is a pair (rowmultiplicity, columnmultiplicity). The rowmultiplicity is the number of rows the cell spans. This number is decrease every time a row ends. So it actually says how many rows the columns spans further down from the current column. The column multiplicity is the number of columns the cell spans. This function take the index of the current column as first parameter. This function takes the parse result of the opening part of the cell environment of the current cell as third input parameter. This function calculates only the changes in the multirowdict for the opening environment of the cell. You should not use this function but rather use multiRowDictChange since this also considers the effect by ending of cells -}+ multiRowDictChangeStart :: Int -> Map Int (Int, Int) -> [Anything Char] -> Map Int (Int, Int) multiRowDictChangeStart i d l@@ -340,17 +340,17 @@ do n <- rowMultiplicity l return (Map.insert i ((n - 1), c) d) where c = (columnMultiplicityForCounting l)- -{-DHUN| calculate the full change to the multirowdict. See documentation on the function multiRowDictChangeStart in this module for more information on the multirowdict. The first parameter is the index of the current column. The second parameter is the current multirowdict. This function takes the parse result of the opening part of the cell environment of the current cell as third input parameter. This function returns the updated multirowdict. DHUN-}- ++{-| calculate the full change to the multirowdict. See documentation on the function multiRowDictChangeStart in this module for more information on the multirowdict. The first parameter is the index of the current column. The second parameter is the current multirowdict. This function takes the parse result of the opening part of the cell environment of the current cell as third input parameter. This function returns the updated multirowdict. -}+ multiRowDictChange :: Int -> Map Int (Int, Int) -> [Anything Char] -> Map Int (Int, Int) multiRowDictChange i d l = multiRowDictChangeStart n (multiRowDictChangeEnd i d) l where n = i + (multiRowCount i d)- -{-DHUN| returns the latex symbol for the start of a multirow cell. That is a cell spanning multiple rows. The second parameter is activeColumn. This is an integer wrapped in the maybe monad. If it is has the value Just then the row is to be renderer in a special mode. This mode is needed to determine the width of the columns. In this special mode no line break occur and width of the paper is infinite, so that the width of the of each column is its respective natural width. So there is no limit on the width of the column. If the value is Nothing this means that the table is typeset in normal mode and the width is to be limited. The first parameter is the inner parse result of the row separator containing information on whether or not the cell is multirow DHUN-}- ++{-| returns the latex symbol for the start of a multirow cell. That is a cell spanning multiple rows. The second parameter is activeColumn. This is an integer wrapped in the maybe monad. If it is has the value Just then the row is to be renderer in a special mode. This mode is needed to determine the width of the columns. In this special mode no line break occur and width of the paper is infinite, so that the width of the of each column is its respective natural width. So there is no limit on the width of the column. If the value is Nothing this means that the table is typeset in normal mode and the width is to be limited. The first parameter is the inner parse result of the row separator containing information on whether or not the cell is multirow -}+ multiRowStartSymbol :: [Anything Char] -> Maybe Int -> String multiRowStartSymbol l m = fromMaybe "" $@@ -359,20 +359,20 @@ "\\multirow{" ++ (show n) ++ "}{" ++ (if isJust m then "*" else "\\linewidth") ++ "}{"- -{-DHUN| a symbol to be added at the end of header cell in order to make its content bold. The only boolean parameter is use to indicate whether the cell currently under consideration is a header cell. Otherwise the empty string is returned. DHUN-}- ++{-| a symbol to be added at the end of header cell in order to make its content bold. The only boolean parameter is use to indicate whether the cell currently under consideration is a header cell. Otherwise the empty string is returned. -}+ headendsym :: Bool -> String headendsym False = "" headendsym True = "}"- -{-DHUN| a symbol to be added at the start of header cell in order to make its content bold DHUN-}- ++{-| a symbol to be added at the start of header cell in order to make its content bold -}+ headstartsym :: String headstartsym = "{\\bfseries "- -{-DHUN| the symbol to be inserted into the latex document, for the end of a row in a table. The first boolean parameter is should be true if the current table is not nested in an other one. The second boolean parameter should be true if the column was the last column of the header of the table. The header of the table is repeated by latex each time page wrapping inside the table occurs. See also documentation of the longtable latex package DHUN-}- ++{-| the symbol to be inserted into the latex document, for the end of a row in a table. The first boolean parameter is should be true if the current table is not nested in an other one. The second boolean parameter should be true if the column was the last column of the header of the table. The header of the table is repeated by latex each time page wrapping inside the table occurs. See also documentation of the longtable latex package -}+ rowendsymb :: Bool -> Bool -> String rowendsymb True True = "\\endhead " rowendsymb _ _ = "\\\\"
src/Tools.hs view
@@ -1,67 +1,89 @@-{-DHUN| various helper functions DHUN-}+{-| various helper functions -} module Tools where import Data.List (isPrefixOf, tails) import Data.Char import Data.List.Split (splitOn) import Control.Monad import System.IO-import Data.List.HT (dropWhileRev)- -{-DHUN| Write a unicode string to a utf8 encoded file. The first parameter is the filename, the second the contend to be written to the file. DHUN-}- +import System.IO.Strict+import Data.Time.Clock.POSIX++{-| Pads a string with spaces. Adds space charactes to the beginning of a string until it has got a desired length. The first paramter is the desired length. The second paramter is the original string. The return value is the padded string. -}+++pad :: Int -> String -> String+pad n s = if length s < n then pad n (' ' : s) else s++{-| creates a list of line numbers as padded strings. The first parameter is the length of length that each linenumber (a string) should have. The second paramter is the minimum linenumber to start with (inclusive). The third parameter is the maximum linenumber to end with (inclusive). The return value is the list of linenumbers as strings. -}++linenumbers :: Int -> Int -> Int -> [String]+linenumbers n mini maxi+ = if mini == maxi then [pad n (show mini)] else+ (pad n (show mini)) : (linenumbers n (mini + 1) maxi)++{-| Prints out a given message together with the current unix timestamp. The first parameter is the message to be printed -}++myprint :: String -> IO ()+myprint s+ = do t <- getPOSIXTime+ Prelude.putStrLn ("mediawiki2latex (" ++ (show t) ++ "):" ++ s)+ hFlush stdout++{-| Write a unicode string to a utf8 encoded file. The first parameter is the filename, the second the contend to be written to the file. -}+ writeFile :: FilePath -> String -> IO () writeFile f s = do h <- openFile f WriteMode hSetEncoding h utf8 hPutStr h s hClose h- -{-DHUN| read a utf8 encoded file fully as a unicode string. The first parameter is the filename. The return value is the content of the file wrapped in the IO monad. DHUN-}- ++{-| read a utf8 encoded file fully as a unicode string. The first parameter is the filename. The return value is the content of the file wrapped in the IO monad. -}+ readFile :: FilePath -> IO String readFile f = do h <- openFile f ReadMode hSetEncoding h utf8- z <- hGetContents h+ z <- System.IO.Strict.hGetContents h return z- -{-DHUN| If the list is not empty it returns the list without the last item, otherwise the empty list- DHUN-}- ++{-| If the list is not empty it returns the list without the last item, otherwise the empty list- -}+ nullinit :: [a] -> [a] nullinit l = if null l then [] else init l- -{-DHUN| Returns the list with the first element stripped wrapped in a Just of the Maybe monad. If the list is empty returns the value Nothing of the maybe monad. DHUN-}- ++{-| Returns the list with the first element stripped wrapped in a Just of the Maybe monad. If the list is empty returns the value Nothing of the maybe monad. -}+ maybeTail :: [a] -> Maybe [a] maybeTail [] = Nothing maybeTail (_ : xs) = Just xs- -{-DHUN| Returns the first element of a list wrapped in a Just of the Maybe monad. If the list is empty returns the value Nothing of the Maybe monad, DHUN-}- ++{-| Returns the first element of a list wrapped in a Just of the Maybe monad. If the list is empty returns the value Nothing of the Maybe monad, -}+ maybeHead :: [a] -> Maybe a maybeHead [] = Nothing maybeHead (x : _) = Just x- -{-DHUN| The first parameter is and item. the second parameter is a list. If the list contains the item it returns the list up to the first occurrence of the item with the item itself excluded, otherwise it returns the empty list. DHUN-}- ++{-| The first parameter is and item. the second parameter is a list. If the list contains the item it returns the list up to the first occurrence of the item with the item itself excluded, otherwise it returns the empty list. -}+ headSplitEq :: (Eq a) => a -> [a] -> [a] headSplitEq c s = case splitOn [c] s of g : _ -> g [] -> []- -{-DHUN| Removes all white space characters trailing on the right hand side of a string DHUN-}- ++{-| Removes all white space characters trailing on the right hand side of a string -}+ rtrim :: String -> String-rtrim = dropWhileRev isSpace- -{-DHUN| The first parameter is an original item. The second parameter is a replacement item. The third parameter is a list. This function replaces all occurrences of the original item, with the replacement item in the list. DHUN-}- +rtrim = reverse . (dropWhile isSpace) . reverse++{-| The first parameter is an original item. The second parameter is a replacement item. The third parameter is a list. This function replaces all occurrences of the original item, with the replacement item in the list. -}+ replace :: (Eq a) => a -> a -> [a] -> [a] replace src target = map (\ x -> if x == src then target else x)- -{-DHUN| The first parameter is an input list. The second parameter is an original list that may or may not or may several times be part of the input list. The third parameter is an a replacement list. This function replaces all occurrences of the original list in the input list, with the replacement list. DHUN-}- ++{-| The first parameter is an input list. The second parameter is an original list that may or may not or may several times be part of the input list. The third parameter is an a replacement list. This function replaces all occurrences of the original list in the input list, with the replacement list. -}+ replace2 :: (Eq a) => [a] -> [a] -> [a] -> [a] replace2 hay needle nail | needle `isPrefixOf` hay =@@ -69,23 +91,23 @@ replace2 (x : xs) needle nail | otherwise = x : (replace2 xs needle nail) replace2 [] _ _ = []- -{-DHUN| The first parameter is an input list. The second parameter is also a list, that might be contained in the input list. If this is the case this function returns true. Otherwise this function returns false DHUN-}- ++{-| The first parameter is an input list. The second parameter is also a list, that might be contained in the input list. If this is the case this function returns true. Otherwise this function returns false -}+ isInfixOf2 :: (Eq a) => [a] -> [a] -> Bool isInfixOf2 needle haystack = any (needle `isPrefixOf`) (tails haystack)- -{-DHUN| Converts a single character in hex notation to an integer. The integer is wrapped in a mMybe monad. If an integer could be found it is wrapped in a Just of the Maybe monad. Otherwise the value Nothing of the Maybe monad is returned DHUN-}- ++{-| Converts a single character in hex notation to an integer. The integer is wrapped in a mMybe monad. If an integer could be found it is wrapped in a Just of the Maybe monad. Otherwise the value Nothing of the Maybe monad is returned -}+ unhexChar :: Char -> Maybe Integer unhexChar c = lookup c hexTable where hexTable = zip ['0' .. '9'] [0 .. 9] ++ zip ['a' .. 'f'] [10 .. 15] ++ zip ['A' .. 'F'] [10 .. 15]- -{-DHUN| Converts a sequence of characters in hex notation to an integer. The integer is wrapped in a Maybe monad. If an integer could be found it is wrapped in a Just of the Maybe monad. Otherwise the value Nothing of the Maybe monad is returned DHUN-}- ++{-| Converts a sequence of characters in hex notation to an integer. The integer is wrapped in a Maybe monad. If an integer could be found it is wrapped in a Just of the Maybe monad. Otherwise the value Nothing of the Maybe monad is returned -}+ unhex :: String -> Maybe Integer unhex = foldM f 0 where f acc ch
− src/TouchJPEG.hs
@@ -1,6 +0,0 @@--module TouchJPEG where-import ImperativeState- -touchJPEG :: ImperativeMonad ()-touchJPEG = return ()
src/UrlAnalyse.hs view
@@ -1,14 +1,13 @@-{-DHUN| module for processing urls and downloading their content with repect to mediawiki DHUN-}+{-# LANGUAGE StandaloneDeriving #-}+{-| module for processing urls and downloading their content with repect to mediawiki -} module UrlAnalyse (getpage, analyse, analyseFull, unify, WikiUrl, getLemma, FullWikiUrl, hostname, url, alternatives, lemma, wikiUrl, geturl,- parses, geturl2, fullWikiUrlZero, getExpandedPage, getpage2)- where-import qualified Network.Browser as Browser+ parses, geturl2, fullWikiUrlZero, getExpandedPage, getpage2, getBookpage)+ where import Network.HTTP.Conduit import Data.ByteString.Lazy.Internal import Network.URL as URL-import Network.HTTP import Control.Monad import Data.Maybe import Data.List.Split@@ -17,48 +16,68 @@ import Data.Tree.NTree.TypeDefs import Codec.Binary.UTF8.String import Control.Exception+import qualified Network.HTTP.Client.Internal as I+import qualified Data.ByteString.Lazy as L+import Control.Exception as X import qualified Data.ByteString as BStr import qualified Data.ByteString.UTF8 as UTF8Str- -{-DHUN| This represents the main url of a wiki page. So the url of the wiki page that should be converted to latex. It is a tuple wrapped into the maybe monad, to deal with case in which the url could not be parses. The first element of the tuple is just the main url parser with Network.URL The second element is a list of urls. These URLs are possible base urls for wiki pages. So en.wikipedia.org/wiki/Foobar has got the main url en.wikipedia.org/wiki/Foobar and one of the base urls us en.wikipedia.org/wiki/. Base urls are important since the wiki source related to the main url might include subpage in wiki notation that is [[JohnDow]]. The actual url to look up JohnDow is the baseurl plus JohnDow so that is en.wikipedia.org/wiki/JohnDow Since also images in the commons and similar things are possible, the are usually some baseurls to be looked at. This way the base URl have to be a list. DHUN-}+import qualified Network.HTTP.Types as T+import qualified Network.HTTP.Types.Version as V++deriving instance Read URL.URL+deriving instance Read URL.Host+deriving instance Read URL.Protocol+deriving instance Read URL.URLType++{-| This represents the main url of a wiki page. So the url of the wiki page that should be converted to latex. It is a tuple wrapped into the maybe monad, to deal with case in which the url could not be parsed. The first element of the tuple is just the main url parsed with Network.URL The second element is a list of urls. These URLs are possible base urls for wiki pages. So en.wikipedia.org/wiki/Foobar has got the main url en.wikipedia.org/wiki/Foobar and one of the base urls us en.wikipedia.org/wiki/. Base urls are important since the wiki source related to the main url might include subpage in wiki notation that is [[JohnDow]]. The actual url to look up JohnDow is the baseurl plus JohnDow so that is en.wikipedia.org/wiki/JohnDow Since also images in the commons and similar things are possible, the are usually some baseurls to be looked at. This way the base URLs have to be a list. -} type WikiUrl = Maybe (URL, [URL]) -{-DHUN| same as WikiURL. two additional parameters. the host parameter is name of host. And lemma is the name of the page on the wiki DHUN-}+{-| same as WikiURL. two additional parameters. the host parameter is name of host. And lemma is the name of the page on the wiki -} wikiUrl :: FullWikiUrl -> WikiUrl wikiUrl fu = return (url fu, alternatives fu) +{-| A type describing a reference to an article on a MediaWiki server. The entry url is the url under which the article is located. The entry alternatives is a list of baseurls of the wiki. See documentation on type WikiUrl for more information about baseurls. The entry hostname contains the hostname of the server. The entry lemma contains the lemma (that is the name of the article on the wiki) -}++ data FullWikiUrl = FullWikiUrl{url :: URL, alternatives :: [URL], hostname :: String, lemma :: String} deriving (Eq, Ord) ++{-| base instance of type FullWikiUrl, to be filled with useful data using the record syntax -}+ fullWikiUrlZero :: FullWikiUrl fullWikiUrlZero = FullWikiUrl{url = URL{URL.url_type = Absolute- (Host{URL.protocol = HTTP False, URL.host = "",+ (Host{URL.protocol = HTTP True, URL.host = "", URL.port = Nothing}), url_path = "", url_params = []}, alternatives = [], hostname = "", lemma = ""} -{-DHUN| returns the list of baseurls of an WikiURL. The list may be empty if the WikiURL has none. See documentation on the type 'WikiURL' to understand what a baseurl is. DHUN-}+{-| returns the list of baseurls of an WikiURL. The list may be empty if the WikiURL has none. See documentation on the type 'WikiURL' to understand what a baseurl is. -} parses :: WikiUrl -> [URL] parses u = do uu <- maybeToList u snd uu -{-DHUN| takes a baseurl and a wiki lemma and creates the url under which the wiki source code of the lemma can be retrieved. So the Url en.wikipedia.org/wiki/FoorBar has possible many baseurls. One of which is en.wikipedia.org/wiki/. The wiki source of the lemma JonDow can be retrieved from the wiki via the url en.wikipedia.org/wiki/Special:Export/JohnDow. Which is just what these function returns. See also documentation on the type 'WikiUrl' on what a baseurl is. DHUN-}+{-| takes a baseurl and a wiki lemma and creates the url under which the wiki source code of the lemma can be retrieved. So the Url en.wikipedia.org/wiki/FoorBar has possible many baseurls. One of which is en.wikipedia.org/wiki/. The wiki source of the lemma JonDow can be retrieved from the wiki via the url en.wikipedia.org/wiki/Special:Export/JohnDow. Which is just what these function returns. See also documentation on the type 'WikiUrl' on what a baseurl is. -} -modpath :: String -> URL -> URL-modpath s u+modpath :: URL -> URL+modpath u = u{url_path =- if p /= [] then p ++ "/Special:Export/" ++ s else- "Special:Export/" ++ s}+ if p /= [] then p ++ "/Special:Export" else+ "Special:Export"} where p = (url_path u) ++{-| modify an URL to point to the special page on the wiki to expand the templates useful for command line option -m -}++ modpathForExpansion :: URL -> URL modpathForExpansion u = u{url_path =@@ -67,59 +86,105 @@ url_params = []} where p = (url_path u) -{-DHUN| load a webpage via http the url to the webpage has to be given as string on the first input parameter. The result of the request is returned as a String wrapped in the IO monad. DHUN-}+{-| load a webpage via http the url to the webpage has to be given as string on the first input parameter. The result of the request is returned as a String wrapped in the IO monad. -} geturl :: String -> IO String geturl u- = Control.Exception.catch- (do x <- Browser.browse $- do Browser.setAllowRedirects True- Browser.request $ getRequest u- return (rspBody (snd x)))+ = if u=="" then return ([]) else Control.Exception.catch+ (do req0 <- parseRequest u+ let req+ = ((urlEncodedBody+ (map (\ (a, b) -> (UTF8Str.fromString a, UTF8Str.fromString b))+ []))+ req0) {method=method req0}+ manager <- newManager tlsManagerSettings+ res <- (httpLbs req manager)`X.catch` statusExceptionHandler+ return ((unpackChars (responseBody res)))) fun- where + where fun :: ErrorCall -> IO String fun _ = return ""+ statusExceptionHandler :: SomeException -> IO (Network.HTTP.Conduit.Response L.ByteString)+ statusExceptionHandler _ = (return (I.Response {responseBody=L.empty,responseStatus=T.Status {T.statusCode=200,T.statusMessage=BStr.empty}, responseVersion=V.http09,responseHeaders=[],responseCookieJar=I.CJ [],I.responseClose'=I.ResponseClose (return ())})) ++{-| Loads the data stored under an URL from the web. Result will be a ByteString. Mainly useful for loading HTML for further processing, as well as binary image files. -}+++geturl2 :: String -> IO BStr.ByteString+geturl2 u+ = if u=="" then return (BStr.pack []) else Control.Exception.catch+ (do req0 <- parseRequest u+ let req+ = ((urlEncodedBody+ (map (\ (a, b) -> (UTF8Str.fromString a, UTF8Str.fromString b))+ []))+ req0) {method=method req0}+ manager <- newManager tlsManagerSettings+ res <- (httpLbs req manager)`X.catch` statusExceptionHandler+ return (L.toStrict (responseBody res)))+ fun+ where + fun :: ErrorCall -> IO BStr.ByteString+ fun _ = return (BStr.pack [])+ statusExceptionHandler :: SomeException -> IO (Network.HTTP.Conduit.Response L.ByteString)+ statusExceptionHandler _ = (return (I.Response {responseBody=L.empty,responseStatus=T.Status {T.statusCode=200,T.statusMessage=BStr.empty}, responseVersion=V.http09,responseHeaders=[],responseCookieJar=I.CJ [],I.responseClose'=I.ResponseClose (return ())}))++{-| loads the wiki sourcecode strored under a lemma in on a server running mediawiki. The first parameter is the lemma to look up. The second parameter is the URL to the special:export page on the server. The return value is the source wikitext -}+++geturl4 :: String -> String -> IO String+geturl4 s u+ = if u=="" then return ([]) else Control.Exception.catch+ (do req1 <- parseRequest (u++"/"++s)+ let req0 = req1 {queryString=UTF8Str.fromString "",path=if (head.reverse$ s)=='?' then (UTF8Str.fromString.(++"%3F").UTF8Str.toString) (path req1) else path req1}+ let req+ = ((urlEncodedBody+ (map (\ (a, b) -> (UTF8Str.fromString a, UTF8Str.fromString b))+ [("mw-input-pages",s),("curonly","1"),("wpExportTemplates","0"),("wpDownload","1")]))+ req0) + manager <- newManager tlsManagerSettings+ res <- (httpLbs req manager)`X.catch` statusExceptionHandler+ return ((unpackChars (responseBody res))))+ fun+ where + fun :: ErrorCall -> IO String+ fun _ = return ""+ statusExceptionHandler :: SomeException -> IO (Network.HTTP.Conduit.Response L.ByteString)+ statusExceptionHandler _ = (return (I.Response {responseBody=L.empty,responseStatus=T.Status {T.statusCode=200,T.statusMessage=BStr.empty}, responseVersion=V.http09,responseHeaders=[],responseCookieJar=I.CJ [],I.responseClose'=I.ResponseClose (return ())}))+++{-| loads the wikisource of a wiki article from a server running mediawiki, with all mediawiki templates expanded into wiki text. The first parameter is the url to special:expand templates page on the server. The second parameter is the wikitext source including the mediawiki templates to be expanded. The third parameter is the name of the lemma on the server. -}++ geturl3 :: String -> String -> String -> IO String geturl3 u d s- = Control.Exception.catch- (do req0 <- parseUrl u+ = if u=="" then return ([]) else Control.Exception.catch+ (do req0 <- parseRequest u let req = (urlEncodedBody (map (\ (a, b) -> (UTF8Str.fromString a, UTF8Str.fromString b)) [("wpInput", d), ("removecomments", "1"), ("removenowiki", "1"), ("generate_xml", "0"), ("contexttitle", s)])) req0- res <- withManager $ httpLbs req+ manager <- newManager tlsManagerSettings+ res <- (httpLbs req manager) `X.catch` statusExceptionHandler return ((unpackChars (responseBody res)))) fun- where + where fun :: ErrorCall -> IO String fun _ = return ""+ statusExceptionHandler :: SomeException -> IO (Network.HTTP.Conduit.Response L.ByteString)+ statusExceptionHandler _ = (return (I.Response {responseBody=L.empty,responseStatus=T.Status {T.statusCode=200,T.statusMessage=BStr.empty}, responseVersion=V.http09,responseHeaders=[],responseCookieJar=I.CJ [],I.responseClose'=I.ResponseClose (return ())})) -geturl2 :: String -> IO BStr.ByteString-geturl2 u- = Control.Exception.catch- (do x <- Browser.browse $- do Browser.setAllowRedirects True- Browser.request $- Request{rqURI = rqURI dg, rqMethod = rqMethod dg,- rqHeaders = rqHeaders dg, rqBody = UTF8Str.fromString (rqBody dg)}- return (rspBody (snd x)))- fun- where - fun :: ErrorCall -> IO BStr.ByteString- fun _ = return (BStr.pack [])- dg = (getRequest u) -{-DHUN| helper function to get the actual wiki source as string out of a part of and xml tree returned by the xml parser. Only used for the function getTextContent DHUN-}+{-| helper function to get the actual wiki source as string out of a part of and xml tree returned by the xml parser. Only used for the function getTextContent -} toText :: [NTree XNode] -> Maybe String toText [NTree _ [NTree (XText l) []]] = Just l toText _ = Nothing -{-DHUN| this function gets the actual wiki source of a wiki page out of the result String returned by the Special:Export function of mediawiki. You should not call this function directly since it may break the flow of control. Better use the function getTextContent2 DHUN-}+{-| this function gets the actual wiki source of a wiki page out of the result String returned by the Special:Export function of mediawiki. You should not call this function directly since it may break the flow of control. Better use the function getTextContent2 -} getTextContent :: String -> IO (Maybe String) getTextContent z@@ -129,12 +194,14 @@ x <- return . toText $ h return (seq x x) -{-DHUN| this function gets the actual wiki source of a wiki page out of the result String returned by the Special:Export function of mediawiki. This function returns its result wrapped in a maybe monad so it can return the maybe value Nothing in case of failure but does not break the flow of control. It is also wrapped in the IO monad since the xml parser used is bound to the IO monad DHUN-}+{-| this function gets the actual wiki source of a wiki page out of the result String returned by the Special:Export function of mediawiki. This function returns its result wrapped in a maybe monad so it can return the maybe value Nothing in case of failure but does not break the flow of control. It is also wrapped in the IO monad since the xml parser used is bound to the IO monad -} getTextContent2 :: String -> IO (Maybe String) getTextContent2 z = catchJust myfun (getTextContent z) (\ _ -> return Nothing) +{-| this function extracts the expanded wiki source of out of the result String returned by the Special:ExpandTemplates function of mediawiki. This function returns its result wrapped in a maybe monad so it can return the maybe value Nothing in case of failure but does not break the flow of control. It is also wrapped in the IO monad since the xml parser used is bound to the IO monad -}+ getExpandedTextContent :: String -> IO (Maybe String) getExpandedTextContent z = do h <- runX@@ -145,36 +212,57 @@ x <- return . toText $ h return (seq x x) +{-| this function extracts the expanded wiki source of out of the result String returned by the Special:ExpandTemplates function of mediawiki. This function returns its result wrapped in a maybe monad so it can return the maybe value Nothing in case of failure but does not break the flow of control. It is also wrapped in the IO monad since the xml parser used is bound to the IO monad. Possible IO errors are caught an rethrown as Nothing in the Maybe Monad -}++ getExpandedTextContent2 :: String -> IO (Maybe String) getExpandedTextContent2 z = catchJust myfun (getExpandedTextContent z) (\ _ -> return Nothing) -{-DHUN| exception predicate interested in all exceptions. Thats means we catch all exceptions. This needed in getTexTContent2 so that the maybe value nothing is returned in case of an exception but the control flow is not interrupted DHUN-}+{-| exception predicate interested in all exceptions. Thats means we catch all exceptions. This needed in getTexTContent2 so that the maybe value nothing is returned in case of an exception but the control flow is not interrupted -} myfun :: SomeException -> Maybe () myfun _ = return () -{-DHUN| gets the wiki source code of a lemma on a wiki. The first parameter is the lemma. So JohnDow for en.wikipedia/wiki/JohnDow. The second parameter is the wikiurl. A wikiurl specifies the wiki from which the data should be downloaded. See documentation on the type 'WikiUrl' for more information. Also see documentation on the function 'analyze' to see how to create a 'WikiUrl'. This function returns the wiki source code of the lemma as String it is wrapped in the IO monad since it does a http request it is also wrapped in the Maybe monad since it may not be able to retrieve the source. DHUN-}+{-| gets the wiki source code of a lemma on a wiki. The first parameter is the lemma. So JohnDow for en.wikipedia/wiki/JohnDow. The second parameter is the wikiurl. A wikiurl specifies the wiki from which the data should be downloaded. See documentation on the type 'WikiUrl' for more information. Also see documentation on the function 'analyze' to see how to create a 'WikiUrl'. This function returns the wiki source code of the lemma as String it is wrapped in the IO monad since it does a http request it is also wrapped in the Maybe monad since it may not be able to retrieve the source. -} getpage :: String -> WikiUrl -> IO (Maybe String) getpage ss u- = do l <- mapM (geturl . unify . exportURL . modpath ss) (parses u)+ = do l <- mapM ((geturl4 ss ). unify . exportURL . modpath) (parses u) ll <- mapM getTextContent2 l lll <- return (seq ll ll) return $ (listToMaybe $ concat (map maybeToList lll)) >>= (return . decodeString) +{-| Loads a page from a wiki when mediawiki2latex is running with command line option --bookmode. The first parameter is the lemma to load from the wiki the second parameter is the WikiUrl to the server hosting the wiki -}+++getBookpage :: String -> WikiUrl -> IO (Maybe String)+getBookpage ss u+ = do l <- mapM ((geturl2) . unify) ((map ((++("wiki/"++ss)).exportURL)) (parses u))+ lll <- return (seq l l)+ return $+ (listToMaybe $ concat (map maybeToList (map go lll))) >>=+ (return)+ where+ go x =if (x==(UTF8Str.fromString [])) then Nothing else Just (UTF8Str.toString x)+++{-| Loads the wikitext of an article form a mediawiki server when mediawiki2latex is running with the --mediawiki option. This function downloads the orignial wikitext source without expanding the templates. This is going to happen later by call to getExpandedPage. The first parmeter is lemma to load. The second paramerter is the WikiUrl to the server hosting the wiki. The return value is a pair. The first element of it is the wikitext source of the article. The second element of it is the URL under which the article was downloaded -}+ getpage2 :: String -> WikiUrl -> IO (Maybe (String, URL)) getpage2 ss u- = do l <- mapM (geturl . unify . exportURL . modpath ss) (parses u)+ = do l <- mapM ((geturl4 ss) . unify . exportURL . modpath) (parses u) ll <- mapM getTextContent2 l lll <- return (seq ll ll) return $ (listToMaybe $ concat (map go (zip lll (parses u)))) where go (Just xx, uu) = [(decodeString xx, uu)] go _ = [] +{-| This function expands all templates in a wikitext source using MediaWiki. The first parameter is lemma to be processed. The second parameter is the wikitext source of the article stored under the lemma. The third parameter is url to Special:ExpandTemplates page on the mediawiki server. The return value is the wikitext source with all templates expanded by MediaWiki -}+ getExpandedPage :: String -> String -> URL -> IO (Maybe String) getExpandedPage ss d u = do l <- mapM@@ -186,7 +274,7 @@ (listToMaybe $ concat (map maybeToList lll)) >>= (return . decodeString) -{-DHUN| unescapes the special character underscore and % from url notation DHUN-}+{-| unescapes the special character underscore and % from url notation -} unify :: [Char] -> [Char] unify ('%' : ('2' : ('0' : xs))) = '_' : unify xs@@ -194,12 +282,12 @@ unify (x : xs) = x : (unify xs) unify [] = [] -{-DHUN| converts an url given as String into a WikiURL. See description on type 'WikiURL' on what that means. DHUN-}+{-| converts an url given as String into a WikiURL. See description on type 'WikiURL' on what that means. -} analyse :: String -> WikiUrl analyse s = do vv <- v- ww <- importURL "http://commons.wikimedia.org/wiki"+ ww <- importURL "https://commons.wikimedia.org/wiki" return (vv, z ++ [ww]) where v = importURL s @@ -212,7 +300,7 @@ [0, 1, 2]) map (\ i -> u{url_path = i}) x -{-DHUN| converts an url given as String into the lemma it points to on the wiki. DHUN-}+{-| converts an url given as String into the lemma it points to on the wiki. -} getLemma :: String -> Maybe String getLemma s = z@@ -230,7 +318,7 @@ else x return $ intercalate "/" xx -{-DHUN| converts an url given as String into the host (as string) it points to on the wiki. DHUN-}+{-| converts an url given as String into the host (as string) it points to on the wiki. -} getHost :: String -> Maybe String getHost s = z@@ -241,7 +329,10 @@ case (url_type u) of Absolute h -> return (URL.host h) _ -> mzero- ++{-| Parse an URL supplied as string in the first parameter into a FullWikiUrl which is returned. See documentation on the types WikiUrl and FullWikiUrl for more information -}++ analyseFull :: String -> Maybe FullWikiUrl analyseFull theUrl = do ana <- analyse theUrl
src/WikiHelper.hs view
@@ -1,4 +1,4 @@-{-DHUN| general helper function for converting from the parsetree to latex DHUN-}+{-| general helper function for converting from the parsetree to latex -} module WikiHelper where import Tools import MediaWikiParseTree@@ -9,16 +9,15 @@ import MyState import Data.List import Data.String.HT (trim)- -{-DHUN| add latex label elements to the parse tree. chapter section subsection and so on will be referenced by these labels. It takes the initial UrlState as second parameter. And the parse tree to be processed as first parameter. It returns a tuple. The first element is them modified urlstate and the second is the modified parse tree with the labels added. The field sUrlState of UrlState contains the page name of the downloaded page currently being processed by the algorithm. the filed mUrlState of UrlState is the number of the currenty label. And ,UrlState is a mapping from combined page and chapter, section etc. names (like urls) to their label numbers. DHUN-}- ++{-| add latex label elements to the parse tree. chapter section subsection and so on will be referenced by these labels. It takes the initial UrlState as second parameter. And the parse tree to be processed as first parameter. It returns a tuple. The first element is them modified urlstate and the second is the modified parse tree with the labels added. The field sUrlState of UrlState contains the page name of the downloaded page currently being processed by the algorithm. the filed mUrlState of UrlState is the number of the currenty label. And ,UrlState is a mapping from combined page and chapter, section etc. names (like urls) to their label numbers. -}+ makeLables :: [Anything Char] -> UrlState -> (UrlState, [Anything Char]) makeLables ll states = let (f, s) = mapAccumL makeLablesForNode states ll in (f, concat s)- where - makeLablesForNode ::+ where makeLablesForNode :: UrlState -> Anything Char -> (UrlState, [Anything Char]) makeLablesForNode st (Environment DhunUrl ss l) = (st{iUrlState = (iUrlState st) + 1, sUrlState = yy,@@ -38,9 +37,9 @@ = (fst zz, [Environment e s (snd $ zz)]) where zz = makeLables l st makeLablesForNode st x = (st, [x])- -{-DHUN| remove superfluous br html tags from the parse tree. Always run before converting the parse tree to latex DHUN-}- ++{-| remove superfluous br html tags from the parse tree. Always run before converting the parse tree to latex -}+ removeBr :: [Anything Char] -> [Anything Char] removeBr ((C '\n') : ((Environment Tag (TagAttr "br" _) _) : xs)) = (C '\n') : removeBr xs@@ -59,26 +58,31 @@ = (Environment SpaceIndent x (removeBr l)) : removeBr xs removeBr (x : xs) = x : removeBr xs removeBr [] = []- -{-DHUN| checks if a given string is an image inclusion in wiki notation. In wiki notation an image is included by [[Image:FooBar.png]], but image may be replace by localized versions like Bild in German, so this function checks for those and return true if it seems to be an image DHUN-}- ++{-| checks if a given string is an image inclusion in wiki notation. In wiki notation an image is included by [[Image:FooBar.png]], but image may be replace by localized versions like Bild in German, so this function checks for those and return true if it seems to be an image -}+ isImage :: String -> Bool isImage x = ([z | z <- map (++ ":") imgtags, z `isPrefixOf` (map toLower x)] /= [])- -{-DHUN| flattens a parse tree shallowly. that is take all characters on the surface level of the parse tree and combines them into a single string. It does not decent into substructures of the parse and so neglects all characters there and does not return those with the exception of character in SpaceIndent environments directly attached to the surface level DHUN-}- ++{-| flattens a parse tree shallowly. that is take all characters on the surface level of the parse tree and combines them into a single string. It does not decent into substructures of the parse and so neglects all characters there and does not return those with the exception of character in SpaceIndent environments directly attached to the surface level -}+ shallowFlatten :: [Anything Char] -> String shallowFlatten ((C a) : xs) = a : (shallowFlatten xs)-shallowFlatten ((S a) : xs) = a ++ (shallowFlatten xs)+shallowFlatten ((Environment HtmlChar (Str "amp") a) : xs)+ = '&' : (shallowFlatten xs)+shallowFlatten ((Environment HtmlChar (Str "lt") a) : xs)+ = '<' : (shallowFlatten xs)+shallowFlatten ((Environment HtmlChar (Str "gt") a) : xs)+ = '>' : (shallowFlatten xs) shallowFlatten ((Environment SpaceIndent _ l) : xs) = '\n' : ((shallowFlatten l) ++ (shallowFlatten xs)) shallowFlatten (_ : xs) = shallowFlatten xs shallowFlatten [] = []- -{-DHUN| A link in wiki notation is given by [foorbar.com a caption]. This function returns the location the link points to so foobar.com as String. It takes the parse tree representation of the link as input parameter DHUN-}- ++{-| A link in wiki notation is given by [foorbar.com a caption]. This function returns the location the link points to so foobar.com as String. It takes the parse tree representation of the link as input parameter -}+ linkLocation :: [Anything Char] -> String linkLocation l = case yy of@@ -90,9 +94,21 @@ (case xx of [] -> "" (g : _) -> g)- -{-DHUN| changes the extension for a filename given in the wiki source to the extension to be used in the latex document. For example svg documents are converted to png documents. So this function converts the string 'svg' to the string 'png' DHUN-}- ++normalizeExtensionHtml :: String -> String+normalizeExtensionHtml ('s' : ('v' : ('g' : _))) = "png"+normalizeExtensionHtml ('j' : ('p' : ('e' : ('g' : _)))) = "jpg"+normalizeExtensionHtml ('j' : ('p' : ('g' : _))) = "jpg"+normalizeExtensionHtml ('g' : ('i' : ('f' : _))) = "gif"+normalizeExtensionHtml ('p' : ('n' : ('g' : _))) = "png"+normalizeExtensionHtml ('t' : ('i' : ('f' : ('f' : _)))) = "png"+normalizeExtensionHtml ('t' : ('i' : ('f' : _))) = "png"+normalizeExtensionHtml (' ' : xs) = normalizeExtension xs+normalizeExtensionHtml (x : xs) = x : (normalizeExtension xs)+normalizeExtensionHtml [] = []++{-| changes the extension for a filename given in the wiki source to the extension to be used in the latex document. For example gif documents are converted to png documents. So this function converts the string 'gif' to the string 'png' -}+ normalizeExtension :: String -> String normalizeExtension ('s' : ('v' : ('g' : _))) = "\\SVGExtension" normalizeExtension ('j' : ('p' : ('e' : ('g' : _)))) = "jpg"@@ -104,7 +120,9 @@ normalizeExtension (' ' : xs) = normalizeExtension xs normalizeExtension (x : xs) = x : (normalizeExtension xs) normalizeExtension [] = []- ++{-| changes the extension for a filename given in the wiki source to the extension to be used in as filename when storing the image in the latex tree. -}+ normalizeExtension2 :: String -> String normalizeExtension2 ('s' : ('v' : ('g' : _))) = "svg" normalizeExtension2 ('j' : ('p' : ('e' : ('g' : _)))) = "jpg"@@ -116,90 +134,90 @@ normalizeExtension2 (' ' : xs) = normalizeExtension xs normalizeExtension2 (x : xs) = x : (normalizeExtension xs) normalizeExtension2 [] = []- -{-DHUN| returns the extension of a filename. DHUN-}- ++{-| returns the extension of a filename. -}+ fileNameToExtension :: String -> String fileNameToExtension s = last (splitOn "." (map toLower s))- -{-DHUN| a predicate that can be run on an element of a parse tree that returns true if the element is a wikilink. A wikilink is denoted as [[Foobar]] in the wiki notation, an links to an other mediawiki page on the same or a different wiki DHUN-}- ++{-| a predicate that can be run on an element of a parse tree that returns true if the element is a wikilink. A wikilink is denoted as [[Foobar]] in the wiki notation, an links to an other mediawiki page on the same or a different wiki -}+ isWikiLink :: (Anything Char) -> Bool isWikiLink (Environment Wikilink _ []) = False isWikiLink (Environment Wikilink _ _) = True isWikiLink _ = False- -{-DHUN| changes Math elements on the surface level of a parse tree to bigmath elements. Those will be rendered as equation environments. Normal math is usually only display be the dollar math environment in latex. DHUN-}- ++{-| changes Math elements on the surface level of a parse tree to bigmath elements. Those will be rendered as equation environments. Normal math is usually only display be the dollar math environment in latex. -}+ shallowEnlargeMath :: [Anything Char] -> [Anything Char] shallowEnlargeMath ((Environment Math s l) : xs) = (Environment BigMath s l) : shallowEnlargeMath xs shallowEnlargeMath (x : xs) = x : shallowEnlargeMath xs shallowEnlargeMath [] = []- -{-DHUN| this function modified chapter headings. It is used when converting a chapter heading from the parse tree to latex. In the wiki often the page name is used as chapter heading and thus only the parts after the slashes and colons are to be taken into account. Also underscores have to be replaced by spaces DHUN-}- ++{-| this function modified chapter headings. It is used when converting a chapter heading from the parse tree to latex. In the wiki often the page name is used as chapter heading and thus only the parts after the slashes and colons are to be taken into account. Also underscores have to be replaced by spaces -}+ chapterTransform :: String -> String chapterTransform s = replace '_' ' ' (last (splitOn ":" (last (splitOn "/" s))))- -{-DHUN| returns the separator to separate items in enumeration, itemizations and so on. Currently this is always \\item{} but this may change depending on which latex package is used to display enumerations and so on. Takes the char for this type of enumeration etc. in wiki notation. That is a hash for enumeration and a asterisk for itemization and so on DHUN-}- ++{-| returns the separator to separate items in enumeration, itemizations and so on. Currently this is always \\item{} but this may change depending on which latex package is used to display enumerations and so on. Takes the char for this type of enumeration etc. in wiki notation. That is a hash for enumeration and a asterisk for itemization and so on -}+ itemSeperator :: Char -> String itemSeperator c = itemSeperator2 [c]- -{-DHUN| see documentation on itemSeperator. The only difference is that this function takes a string containing a single character instead of the single character itself DHUN-}- ++{-| see documentation on itemSeperator. The only difference is that this function takes a string containing a single character instead of the single character itself -}+ itemSeperator2 :: String -> String itemSeperator2 "#" = "\\item{}" itemSeperator2 ":" = "\\item{}" itemSeperator2 ";" = "\\item{}" itemSeperator2 "*" = "\\item{}" itemSeperator2 _ = "\\item{}"- -{-DHUN| returns the name of a latex environment for an itemization enumeration etc.. The first parameter is a string in wiki notation and declare which type environment should be used. The second parameter is a float giving the width of the current cell in units of the line width when inside a table and is 1.0 if currently not inside any table. DHUN-}- ++{-| returns the name of a latex environment for an itemization enumeration etc.. The first parameter is a string in wiki notation and declare which type environment should be used. The second parameter is a float giving the width of the current cell in units of the line width when inside a table and is 1.0 if currently not inside any table. -}+ itemEnvironmentName :: String -> Float -> String itemEnvironmentName "#" _ = "myenumerate" itemEnvironmentName ":" _ = "myquote" itemEnvironmentName ";" _ = "mydescription" itemEnvironmentName "*" _ = "myitemize" itemEnvironmentName _ _ = "list"- -{-DHUN| returns additional parameter for the opening of a latex environment for an itemization enumeration etc. The second parameter is a float giving the width of the current cell in units of the line width when inside a table and is 1.0 if currently not inside any table. DHUN-}- ++{-| returns additional parameter for the opening of a latex environment for an itemization enumeration etc. The second parameter is a float giving the width of the current cell in units of the line width when inside a table and is 1.0 if currently not inside any table. -}+ itemEnvironmentParameters :: String -> Float -> String itemEnvironmentParameters "#" _ = "" itemEnvironmentParameters ":" _ = "" itemEnvironmentParameters ";" _ = "" itemEnvironmentParameters "*" _ = "" itemEnvironmentParameters _ _ = "{\\labelitemi}{\\leftmargin=1em}"- -{-DHUN| do multple replacements in a row. The first argument is haystack. The second one a list of pair of a needle and a corresponding nail. The haystack with each needle replaced by a nail is returned DHUN-}- ++{-| do multple replacements in a row. The first argument is haystack. The second one a list of pair of a needle and a corresponding nail. The haystack with each needle replaced by a nail is returned -}+ multireplace :: (Eq a) => [a] -> [([a], [a])] -> [a] multireplace haystack ((needle, nail) : xs) = multireplace (replace2 haystack needle nail) xs multireplace haystack [] = haystack- -{-DHUN| converts a mathematical expression (that is something within a math tag in the wiki) to an latex expression. Essentially the wiki is using latex. But it allows for some extra features that are take care of in this transformation DHUN-}- ++{-| converts a mathematical expression (that is something within a math tag in the wiki) to an latex expression. Essentially the wiki is using latex. But it allows for some extra features that are take care of in this transformation -}+ mathTransform :: [Anything Char] -> String mathTransform x = multireplace (replace '\n' ' ' (shallowFlatten x)) replist- -{-DHUN| list of replacements to be applied to contents of math tags in wiki notation for use in the latex equation environment DHUN-}- ++{-| list of replacements to be applied to contents of math tags in wiki notation for use in the latex equation environment -}+ replist :: [([Char], [Char])] replist- = [("\\or", "\\vee{}"), ("%", "\\%"), ("\\and", "\\wegde"),+ = [("\\or", "\\vee{}"), ("%", "\\%"), ("\\and", "\\wedge{}"), ("\\begin{align}", "\\begin{aligned}"), ("\\end{align}", "\\end{aligned}"), ("\\\\%", "\\%"), ("\\part ", "\\partial "), ("\\part{", "\\partial{"), ("\\;", ""), ("\\|", "\\Vert"), ("\\!", ""), ("\\part\\", "\\partial\\")]- -{-DHUN| helper function for line breaking in source code and preformatted block. Not to be called from outside this module. Converts character to parse tree entities, to be process by breakLinesHelper3 DHUN-}- ++{-| helper function for line breaking in source code and preformatted block. Not to be called from outside this module. Converts character to parse tree entities, to be process by breakLinesHelper3 -}+ breakLinesHelper4 :: [Anything Char] -> [Anything Char] breakLinesHelper4 ((C '\n') : xs) = (Environment Tag (TagAttr "br" Map.empty) []) :@@ -208,14 +226,14 @@ breakLinesHelper4 ((C ' ') : xs) = Quad : breakLinesHelper4 xs breakLinesHelper4 (x : xs) = x : breakLinesHelper4 xs breakLinesHelper4 [] = []- -{-DHUN| the width of a tab character in spaces DHUN-}- ++{-| the width of a tab character in spaces -}+ tabwidth :: Int tabwidth = 4- -{-DHUN| helper function for line breaking in source code and preformatted block. Not to be called from outside this module. Inserts br tags where line breaks are needed, the first parameter is an integer which represents the current column in the text, it should be zero when this function is called externally. The second parameter is an integer an represents the maximum length of the line in characters. The third input parameter is the code block to which the line breaks should be added in parse tree notation. The function returns the code block with added br tags for the line breaks in parse tree notation DHUN-}- ++{-| helper function for line breaking in source code and preformatted block. Not to be called from outside this module. Inserts br tags where line breaks are needed, the first parameter is an integer which represents the current column in the text, it should be zero when this function is called externally. The second parameter is an integer an represents the maximum length of the line in characters. The third input parameter is the code block to which the line breaks should be added in parse tree notation. The function returns the code block with added br tags for the line breaks in parse tree notation -}+ breakLinesHelper3 :: Int -> Int -> [Anything Char] -> [Anything Char] breakLinesHelper3 _ m ((Environment Tag (TagAttr "br" y) []) : xs)@@ -243,15 +261,15 @@ = (xx /= Quad) && (xx /= (Environment Tag (TagAttr "br" Map.empty) [])) breakLinesHelper3 _ _ [] = []- -{-DHUN| Breaks lines in source code and preformatted block. Inserts br tags where line breaks are needed. The first parameter is an integer an represents the maximum length of the line in characters. The second input parameter is the code block to which the line breaks should be added in parse tree notation. The function returns the code block with added br tags for the line breaks in parse tree notation DHUN-}- ++{-| Breaks lines in source code and preformatted block. Inserts br tags where line breaks are needed. The first parameter is an integer an represents the maximum length of the line in characters. The second input parameter is the code block to which the line breaks should be added in parse tree notation. The function returns the code block with added br tags for the line breaks in parse tree notation -}+ breakLines3 :: Int -> [Anything Char] -> [Anything Char] breakLines3 m s = rebreak (breakLinesHelper3 0 m (breakLinesHelper4 s))- -{-DHUN| Adds quads in between double br line breaks, needed since double \\newline is not allowed in latex DHUN-}- ++{-| Adds quads in between double br line breaks, needed since double \\newline is not allowed in latex -}+ rebreak :: [Anything Char] -> [Anything Char] rebreak ((Environment Tag (TagAttr "br" a) l) :@@ -260,9 +278,9 @@ Quad : (rebreak ((Environment Tag (TagAttr "br" a2) l2) : xs)) rebreak (x : xs) = x : (rebreak xs) rebreak [] = []- -{-DHUN| Replaces several parse tree item representations of white space characters with the corresponding whitespace characters themselves in parse tree notation. DHUN-}- ++{-| Replaces several parse tree item representations of white space characters with the corresponding whitespace characters themselves in parse tree notation. -}+ renormalize :: Anything Char -> Anything Char renormalize (Environment Tag (TagAttr "br" _) []) = C '\n' renormalize Quad = C ' '
src/WikiLinkHelper.hs view
@@ -1,4 +1,4 @@-{-DHUN| helper functions to convert from parse tree notation to latex notation DHUN-}+{-| helper functions to convert from parse tree notation to latex notation -} module WikiLinkHelper where import Tools import qualified Data.Map as Map@@ -12,9 +12,9 @@ import Data.Char import Data.List.Split import Control.Monad- -{-DHUN| takes a list of language prefixes and sister project prefixes and return a the first one or two elements of that list as tuple of Strings wrapped into maybe monads, returns nothing at the appropriate elements to the tuple if the list does not have enough elements. The first element of the tuple is populated first DHUN-}- ++{-| takes a list of language prefixes and sister project prefixes and return a the first one or two elements of that list as tuple of Strings wrapped into maybe monads, returns nothing at the appropriate elements to the tuple if the list does not have enough elements. The first element of the tuple is populated first -}+ getprefixes :: [String] -> (Maybe String, Maybe String) getprefixes ss = case ss of@@ -23,9 +23,9 @@ case xs of [] -> Nothing (y : _) -> Just $ filter (not . isSpace) (map toLower y))- -{-DHUN| in the wiki source a heading is given by == foo bar == where the number of space gives the level of the heading. In latex this is done with string like 'section. This function translates from wiki notation to latex notation DHUN-}- ++{-| in the wiki source a heading is given by == foo bar == where the number of space gives the level of the heading. In latex this is done with string like 'section. This function translates from wiki notation to latex notation -}+ getsec :: String -> String getsec "=" = "chapter" getsec "==" = "section"@@ -34,9 +34,9 @@ getsec "=====" = "paragraph" getsec "======" = "subparagraph" getsec _ = "subparagraph"- -{-DHUN| in the wiki source a heading is given by == foo bar == where the number of space gives the level of the heading. In latex this is done with string like 'section'. Some of with need additional commands after the actual heading command. Those are returned by this function DHUN-}- ++{-| in the wiki source a heading is given by == foo bar == where the number of space gives the level of the heading. In latex this is done with string like 'section'. Some of with need additional commands after the actual heading command. Those are returned by this function -}+ getsecpost :: String -> String getsecpost "=" = "\n\\myminitoc\n" getsecpost "==" = ""@@ -45,31 +45,31 @@ getsecpost "=====" = "{$\\text{ }$}\\newline" getsecpost "======" = "{$\\text{ }$}\\newline" getsecpost _ = "{$\\text{ }$}\\newline"- -{-DHUN| a predicate that returns true if the string is a valid image size in wiki notation. In the wiki an image is include like [[Image:FoorBar.png|300px]] where 300px means that the image should be displayed at a width of 300 pixel. This function takes strings and looks whether it looks like an integer number flowed by 'px' and is thus a valid width definition for an image in wiki notation DHUN-}- ++{-| a predicate that returns true if the string is a valid image size in wiki notation. In the wiki an image is include like [[Image:FoorBar.png|300px]] where 300px means that the image should be displayed at a width of 300 pixel. This function takes strings and looks whether it looks like an integer number flowed by 'px' and is thus a valid width definition for an image in wiki notation -}+ isImageSize :: String -> Bool isImageSize x = if (isSuffixOf "px" x) then if (reads (take ((length x) - 2) x)) == ([] :: [(Float, [Char])]) then False else True else False- -{-DHUN| this predicate returns true if the string seems to be a caption of an image in wiki notation. And image give like [[Image:JohnDow.png|foo bar]] where 'foo bar' is the caption of the image. So this function just tests whether the string looks like one of the reserved keyword of mediawiki or like an image size definition (see function isImageSize) and return true if none of that fits DHUN-}- ++{-| this predicate returns true if the string seems to be a caption of an image in wiki notation. And image give like [[Image:JohnDow.png|foo bar]] where 'foo bar' is the caption of the image. So this function just tests whether the string looks like one of the reserved keyword of mediawiki or like an image size definition (see function isImageSize) and return true if none of that fits -}+ isCaption :: String -> Bool isCaption x = if isImageSize x then False else if x `elem` ["thumb", "right", "left", "center"] then False else True- -{-DHUN| escapes all charters of a string for use a a link with the hyperref package in latex DHUN-}- ++{-| escapes all charters of a string for use a a link with the hyperref package in latex -}+ escapelink :: String -> String escapelink s = concat (map chartransforlink s)- -{-DHUN| analyzes a host name. If it belongs to a wikimedia project it returns an UrlInfo value otherwise it returns a WikiBaseUrl value. In any case it is the type WikiUrlData. This information is needed when building writing down links to subpages in latex or downloading images from the wiki. DHUN-}- ++{-| analyzes a host name. If it belongs to a wikimedia project it returns an UrlInfo value otherwise it returns a WikiBaseUrl value. In any case it is the type WikiUrlData. This information is needed when building writing down links to subpages in latex or downloading images from the wiki. -}+ analyseNetloc :: String -> WikiUrlData analyseNetloc nl = myurldata where langm@@ -95,54 +95,54 @@ splits = splitOn "." nl (prefix, prefix2) = getprefixes splits wikiset = Set.fromList . Map.elems . Map.fromList $ multilangwikis- -{-DHUN| splits a wikilink in caption and link target and returns the target. So a wkilink is given like [[FooBar|John Dow]]. This link links to the lemma FooBar and is displayed with the caption 'John Dow'. So this function returns FooBar for that link. DHUN-}- ++{-| splits a wikilink in caption and link target and returns the target. So a wkilink is given like [[FooBar|John Dow]]. This link links to the lemma FooBar and is displayed with the caption 'John Dow'. So this function returns FooBar for that link. -}+ localWikiLinkLocation :: String -> String localWikiLinkLocation s = headSplitEq '|' s- -{-DHUN| This function takes the contend of a wikilink in wiki markup notation as first input parameter in parse tree notation. It takes the state of the Latex Renderer as second input parameter. It returns the absolute url of the given wikilink as string DHUN-}- ++{-| This function takes the contend of a wikilink in wiki markup notation as first input parameter in parse tree notation. It takes the state of the Latex Renderer as second input parameter. It returns the absolute url of the given wikilink as string -}+ wikiLinkLocationesc :: [Anything Char] -> MyState -> String wikiLinkLocationesc l st = getUrlFromWikiLinkInfoesc . getWikiLinkInfo (shallowFlatten l) . urld $ st- -{-DHUN| converts a WikiLinkInfo value pointing to a page on a wiki to the full url of that page as string. It is escaped for the use with the hyperref latex package DHUN-}- ++{-| converts a WikiLinkInfo value pointing to a page on a wiki to the full url of that page as string. It is escaped for the use with the hyperref latex package -}+ getUrlFromWikiLinkInfoesc :: WikiLinkInfo -> String getUrlFromWikiLinkInfoesc i = case (urldata i) of- UrlInfo x -> "http://" +++ UrlInfo x -> "https://" ++ (language x) ++ "." ++ (wikitype x) ++ ".org/wiki/" ++ (escapelink (urlEncode (page i)))- BaseUrl (WikiBaseUrl x) -> "http://" +++ BaseUrl (WikiBaseUrl x) -> "https://" ++ x ++ "/wiki/" ++ (escapelink (urlEncode (page i)))- -{-DHUN| converts a WikiLinkInfo value pointing to a page on a wiki to the full url of that page as string. It is not is escaped in any way, so ready for use in a webbrowers DHUN-}- ++{-| converts a WikiLinkInfo value pointing to a page on a wiki to the full url of that page as string. It is not is escaped in any way, so ready for use in a webbrowers -}+ getUrlFromWikiLinkInfo :: WikiLinkInfo -> String getUrlFromWikiLinkInfo i = case (urldata i) of- UrlInfo x -> "http://" +++ UrlInfo x -> "https://" ++ (language x) ++ "." ++ (wikitype x) ++ ".org/wiki/" ++ (urlEncode (page i))- BaseUrl (WikiBaseUrl x) -> "http://" +++ BaseUrl (WikiBaseUrl x) -> "https://" ++ x ++ "/wiki/" ++ (urlEncode (page i))- -{-DHUN| converts a WikiUrlData value pointing to a wiki and a string (like a part of a url) pointing to a page relative to that wiki and returns the full url of that page as string DHUN-}- ++{-| converts a WikiUrlData value pointing to a wiki and a string (like a part of a url) pointing to a page relative to that wiki and returns the full url of that page as string -}+ wikiUrlDataToString :: WikiUrlData -> String -> String wikiUrlDataToString w i = case w of- UrlInfo x -> "http://" +++ UrlInfo x -> "https://" ++ (language x) ++ "." ++ (wikitype x) ++ ".org" ++ i- BaseUrl (WikiBaseUrl x) -> "http://" ++ x ++ i- -{-DHUN This function takes the contend of a wikilink in wiki markup notation as first input parameter. So for the wiki link (mediawiki markup notation) [[en:JohnDow|John Dow]] this is 'en:JohnDow|John Dow' (the single quotes were added to make the string distinguishable from the text and are not part of the passed parameter). It takes the WikiUrlData value describing the wiki the page currently being processed belongs to as second parameter. It returns a WikiLinkInfo value describing the target of the link given as first parameter when evaluated with respect to the second parameter DHUN-}- + BaseUrl (WikiBaseUrl x) -> "https://" ++ x ++ i++{-| This function takes the contend of a wikilink in wiki markup notation as first input parameter. So for the wiki link (mediawiki markup notation) [[en:JohnDow|John Dow]] this is 'en:JohnDow|John Dow' (the single quotes were added to make the string distinguishable from the text and are not part of the passed parameter). It takes the WikiUrlData value describing the wiki the page currently being processed belongs to as second parameter. It returns a WikiLinkInfo value describing the target of the link given as first parameter when evaluated with respect to the second parameter -}+ getWikiLinkInfo :: String -> WikiUrlData -> WikiLinkInfo getWikiLinkInfo s i = WikiLinkInfo{urldata = udata, page = pagen} where udata
+ src/babel/zh view
@@ -0,0 +1,7 @@+\HyphSubstLet{ngerman}{ngerman-x-latest}+\usepackage{xeCJK}+\setCJKmainfont{WenQuanYi Zen Hei}+\newcommand{\mychapterbabel}{章}+\newcommand{\mypagebabel}{页}+\newcommand{\myfigurebabel}{图形}+\newcommand{\mylangbabel}{chinese}
src/mediawiki2latex.hs view
@@ -1,8 +1,8 @@-{-DHUN| This is the main entry point of mediawiki2latex it parses the command line and delegatesto the requested submodules DHUN-}+{-| This is the main entry point of mediawiki2latex it parses the command line and delegatesto the requested submodules -} module Main where import All import Control.Monad.State-import Control.Monad.Error+import Control.Monad.Except import System.Directory import System.Environment import System.Console.GetOpt@@ -13,9 +13,11 @@ import Server import System.FilePath.Posix import System.Info+import Compiler (runCompile)+import Tools (replace2) -{-DHUN| Data structure to repesent a single option on the command line. DHUN-}- +{-| Data structure to repesent a single option on the command line. -}+ data Flag = Verbose | Vector | Version@@ -23,91 +25,127 @@ | Resolution String | Paper String | Copy String+ | Headers String | Input String | Output String | LibDir String+ | Featured String | MediaWiki+ | BookMode | HTML | InternalTemplates | Hex String+ | Zip+ | EPub+ | Odt | Server String deriving (Show, Eq)- -{-DHUN| String constant on for the "version" commad line option. DHUN-}+{-| String constant on for the version command line option. -} versionOption :: String versionOption = "version"- -{-DHUN| String constant on for the "resolution" commad line option. DHUN-} +{-| String constant on for the featured command line option. -}++featuredOption :: String+featuredOption = "featured"++{-| String constant on for the resolution command line option. -}+ resolutionOption :: String resolutionOption = "resolution"- -{-DHUN| String constant on for the "output" commad line option. DHUN-} +{-| String constant on for the output command line option. -}+ output :: String output = "output"- -{-DHUN| String constant on for the "hex" commad line option. DHUN-} +{-| String constant on for the zip command line option. -}++zip :: String+zip = "zip"++{-| String constant on for the hex command line option. -}+ hexen :: String hexen = "hex"- -{-DHUN| String constant on for the "templates" commad line option. DHUN-} +{-| String constant on for the templates command line option. -}+ templates :: String templates = "templates" -{-DHUN| String constant on for the "url" commad line option. DHUN-}+{-| String constant on for the headers command line option. -} +headers :: String+headers = "headers"++{-| String constant on for the url command line option. -}+ url :: String url = "url"- -{-DHUN| String constant on for the "medaiwiki" commad line option. DHUN-}+{-| String constant on for the medaiwiki command line option. -} mediawiki :: String mediawiki = "mediawiki"- -{-DHUN| String constant on for the "html" commad line option. DHUN-} +{-| String constant on for the book-namespace command line option. -}++bookmode :: String+bookmode = "bookmode"++{-| String constant on for the html command line option. -}+ html :: String html = "html"- -{-DHUN| String constant on for the "paper" commad line option. DHUN-} +{-| String constant on for the paper command line option. -}+ paperOption :: String paperOption = "paper"- -{-DHUN| String constant on for the "internal" commad line option. DHUN-} +{-| String constant on for the internal command line option. -}+ internal :: String internal = "internal"- -{-DHUN| String constant on for the "vector" commad line option. DHUN-} +{-| String constant on for the vector command line option. -}+ vectorOption :: String vectorOption = "vector" -{-DHUN| String constant on for the "copy" commad line option. DHUN-}- +{-| String constant on for the copy command line option. -}+ copyOption :: String copyOption = "copy" -{-DHUN| String constant on for the "server" commad line option. DHUN-}+{-| String constant on for the server command line option. -} serverOption :: String serverOption = "server"- -{-DHUN| Datastructure describing all possible command line options DHUN-} +{-| String constant on for the epub command line option. -}++epubOption :: String+epubOption = "epub"++{-| String constant on for the odt command line option. -}++odtOption :: String+odtOption = "odt"++{-| Datastructure describing all possible command line options -}+ options :: [OptDescr Flag] options = [Option ['V', '?', 'v'] [versionOption, "help"] (NoArg Version) "show version number", Option ['o'] [output] (ReqArg Output "FILE") "output FILE (REQUIRED)",+ Option ['f'] [featuredOption] (ReqArg Featured "START:END")+ "run selftest on featured article numbers from START to END", Option ['x'] [hexen] (ReqArg Hex "CONFIG") "hex encoded full configuration for run", Option ['s'] [serverOption] (ReqArg Server "PORT")@@ -123,15 +161,23 @@ "use MediaWiki to expand templates", Option ['h'] [html] (NoArg Main.HTML) "use MediaWiki generated html as input (default)",+ Option ['k'] [bookmode] (NoArg BookMode)+ "use book-namespace mode for expansion",+ Option ['z'] [Main.zip] (NoArg Main.Zip)+ "output zip archive of latex source",+ Option ['b'] [epubOption] (NoArg Main.EPub) "output epub file",+ Option ['d'] [odtOption] (NoArg Main.Odt) "output odt file", Option ['g'] [vectorOption] (NoArg Main.Vector) "keep vector graphics in vector form", Option ['i'] [internal] (NoArg Main.InternalTemplates) "use internal template definitions",+ Option ['l'] [Main.headers] (ReqArg Main.Headers "DIRECTORY")+ "use user supplied latex headers", Option ['c'] [copyOption] (ReqArg Main.Copy "DIRECTORY") "copy LaTeX tree to DIRECTORY"]- -{-DHUN| parsed the options given on the command line via the getopt library DHUN-} +{-| parsed the options given on the command line via the getopt library -}+ compilerOpts :: [String] -> IO ([Flag], [String]) compilerOpts argv = case getOpt Permute options argv of@@ -139,25 +185,25 @@ (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options)) -{-DHUN| header string for the usage help DHUN-}- +{-| header string for the usage help -}+ header :: String header = "Usage: mediawiki2latex [OPTION...]" -{-DHUN| header string giving the current version string of mediawiki2latex DHUN-}+{-| header string giving the current version string of mediawiki2latex -} versionHeader :: String versionHeader- = "mediawiki2latex version 7.4\n" ++ (usageInfo header options)+ = "mediawiki2latex version 7.33\n" ++ (usageInfo header options) -{-DHUN| print the version string of mediawiki2latex. Takes the output of the compilerOpts function as input. Prints the version string if no options were given or the version command was given does noting otherwise DHUN-}+{-| print the version string of mediawiki2latex. Takes the output of the compilerOpts function as input. Prints the version string if no options were given or the version command was given does noting otherwise -} printVersion :: (Eq a) => ([Flag], [a]) -> IO () printVersion o = if (Version `elem` (fst o)) || o == ([], []) then putStrLn versionHeader >> exitSuccess else return () -{-DHUN| checks whether the given option exists exactly once in the given (getopt parsed) command line. Takes a predicate (returning a Maybe type) as first input parameter. Takes the decription string for the option under consideration as second parameter. Takes the (getopt parsed) command line as third input parameter. Return an either monad giving Right together with the value of the option in cases the option exists exacatly once in the command line, gives Left with an Error values otherwise DHUN-}+{-| checks whether the given option exists exactly once in the given (getopt parsed) command line. Takes a predicate (returning a Maybe type) as first input parameter. Takes the decription string for the option under consideration as second parameter. Takes the (getopt parsed) command line as third input parameter. Return an either monad giving Right together with the value of the option in cases the option exists exacatly once in the command line, gives Left with an Error values otherwise -} exactlyOne :: (a -> Maybe b) -> String -> [a] -> Either MyError b exactlyOne predicate s o@@ -165,8 +211,8 @@ ((Just x) : []) -> Right x _ -> Left (NotExcatlyOneError s) -{-DHUN| checks whether the given option exists at most once in the given (getopt parsed) command line. Takes a predicate (returning a Maybe type) as first input parameter. Takes the decription string for the option under consideration as second parameter. Takes the (getopt parsed) command line as third input parameter. Return an either monad giving Right together with the value of the option in cases the option exists at most once once in the command line, gives Left with an Error values otherwise DHUN-}- +{-| checks whether the given option exists at most once in the given (getopt parsed) command line. Takes a predicate (returning a Maybe type) as first input parameter. Takes the decription string for the option under consideration as second parameter. Takes the (getopt parsed) command line as third input parameter. Return an either monad giving Right together with the value of the option in cases the option exists at most once once in the command line, gives Left with an Error values otherwise -}+ atMostOne :: (a1 -> Maybe a) -> String -> [a1] -> Either MyError (Maybe a) atMostOne predicate s o@@ -174,157 +220,222 @@ (x : []) -> Right x ([]) -> Right Nothing _ -> Left (NotAtMostOneError s)- -{-DHUN| predicate for the "resolution" option. see atMostOne and exactlyOne functions for details DHUN-} +{-| predicate for the resolution option. see atMostOne and exactlyOne functions for details -}+ resolutionPredicate :: Flag -> Maybe String resolutionPredicate (Resolution x) = Just x resolutionPredicate _ = Nothing -{-DHUN| predicate for the "copy" option. see atMostOne and exactlyOne functions for details DHUN-}- +{-| predicate for the copy option. see atMostOne and exactlyOne functions for details -}+ copyPredicate :: Flag -> Maybe String copyPredicate (Copy x) = Just x copyPredicate _ = Nothing -{-DHUN| predicate for the "output" option. see atMostOne and exactlyOne functions for details DHUN-}+{-| predicate for the output option. see atMostOne and exactlyOne functions for details -} outputPredicate :: Flag -> Maybe String outputPredicate (Output x) = Just x outputPredicate _ = Nothing -{-DHUN| predicate for the "input" option. see atMostOne and exactlyOne functions for details DHUN-}+{-| predicate for the input option. see atMostOne and exactlyOne functions for details -} inputPredicate :: Flag -> Maybe String inputPredicate (Input x) = Just x inputPredicate _ = Nothing -{-DHUN| predicate for the "templates" option. see atMostOne and exactlyOne functions for details DHUN-}+{-| predicate for the templates option. see atMostOne and exactlyOne functions for details -} templatesPredicate :: Flag -> Maybe String templatesPredicate (Templates x) = Just x templatesPredicate _ = Nothing -{-DHUN| predicate for the "hex" option. see atMostOne and exactlyOne functions for details DHUN-}- +{-| predicate for the headers option. see atMostOne and exactlyOne functions for details -}++headersPredicate :: Flag -> Maybe String+headersPredicate (Headers x) = Just x+headersPredicate _ = Nothing++{-| predicate for the hex option. see atMostOne and exactlyOne functions for details -}+ hexPredicate :: Flag -> Maybe String hexPredicate (Hex x) = Just x hexPredicate _ = Nothing -{-DHUN| predicate for the "server" option. see atMostOne and exactlyOne functions for details DHUN-}+{-| predicate for the server option. see atMostOne and exactlyOne functions for details -} serverPredicate :: Flag -> Maybe String serverPredicate (Server x) = Just x serverPredicate _ = Nothing- -{-DHUN| predicate for the "paper" option. see atMostOne and exactlyOne functions for details DHUN-} +featuredPredicate :: Flag -> Maybe String+featuredPredicate (Featured x) = Just x+featuredPredicate _ = Nothing++{-| predicate for the paper option. see atMostOne and exactlyOne functions for details -}+ paperPredicate :: Flag -> Maybe String paperPredicate (Paper x) = Just x paperPredicate _ = Nothing- -{-DHUN| default images resolution. All images with a right resolution will be dithered to this resolution unless is is overridden with the "resolution" command line option DHUN-} +{-| default images resolution. All images with a right resolution will be dithered to this resolution unless is is overridden with the resolution command line option -}+ defaultResolution :: Integer defaultResolution = 300- -{-DHUN| the default paper format DHUN-} +{-| the default paper format -}+ defaultPaper :: String defaultPaper = "A4" -{-DHUN| function to count the number of given command lines options which are part of a certain set of possible command line options. Takes a Maybe value representing whether the command line option is present and returns 1 on Just and 0 otherwise DHUN-}+{-| function to count the number of given command lines options which are part of a certain set of possible command line options. Takes a Maybe value representing whether the command line option is present and returns 1 on Just and 0 otherwise -} maybeToInt :: (Num a) => Maybe t -> a maybeToInt (Just _) = 1 maybeToInt _ = 0 -{-DHUN| function to count the number of given command lines option which are part of a certain set of possible command line options. Takes a Bool values representing whether the command line option is present and returns 1 on True and 0 otherwise DHUN-}+{-| function to count the number of given command lines option which are part of a certain set of possible command line options. Takes a Bool values representing whether the command line option is present and returns 1 on True and 0 otherwise -} boolToInt :: (Num a) => Bool -> a boolToInt True = 1 boolToInt _ = 0- -{-DHUN| Caculates a configuration information for the run of program from the options given on the command line. It takes the pathname of the current working directory as first input parameter. It takes the (getopt parsed) command line as second input parameter.It returns an Either Monad. In case the command line made sence the Right type containg the configuation is returned otherwise the Left values with a Error Values desribing the problem is returned DHUN-} +{-| Caculates a configuration information for the run of program from the options given on the command line. It takes the pathname of the current working directory as first input parameter. It takes the (getopt parsed) command line as second input parameter.It returns an Either Monad. In case the command line made sence the Right type containg the configuation is returned otherwise the Left values with a Error Values desribing the problem is returned -}+ checkOpts :: FilePath -> [Flag] -> Either MyError FullConfig checkOpts cwd o = do serverVal <- atMostOne serverPredicate serverOption o- case serverVal of- Just x -> case reads x of- [(z, _)] -> return- FullConfig{resolution = 300, outputFilename = "",- inputUrl = "", runMode = ImperativeState.HTML,- paper = "A4", vector = False,- ImperativeState.copy = Nothing, mainPath = "",- server = Just z}- _ -> Left (NotIntegerError serverOption)- _ -> do hexVal <- atMostOne hexPredicate hexen o- case hexVal of- Just x -> return ((read . unhex) x)- _ -> do resolutionOpt <- atMostOne resolutionPredicate- resolutionOption- o- resolutionVal <- case resolutionOpt of- (Just x) -> case reads x of- [(z, _)] -> Right z- _ -> Left- (NotIntegerError- resolutionOption)- _ -> Right defaultResolution- outputVal <- exactlyOne outputPredicate output o- inputVal <- exactlyOne inputPredicate url o- templatesVal <- atMostOne templatesPredicate templates o- copyVal <- atMostOne copyPredicate copyOption o- paperOpt <- atMostOne paperPredicate paperOption o- paperVal <- case paperOpt of- Just x -> if- x `elem`- ["A4", "A5", "B5", "letter", "legal",- "executive"]- then Right x else Left PaperError- _ -> Right defaultPaper- let mediaWikiVal = (MediaWiki `elem` o)- let htmlVal = (Main.HTML `elem` o)- let temVal = (Main.InternalTemplates `elem` o)- let vectorVal = (Main.Vector `elem` o)- let mysum- = (boolToInt temVal) + (boolToInt mediaWikiVal) +- (boolToInt htmlVal)- + (maybeToInt templatesVal)- if mysum > 1 then Left ToManyOptionsError else Right ()- runModeVal <- if mysum == (1 :: Integer) then- case templatesVal of- Just xx -> Right (UserTemplateFile xx)- _ -> if mediaWikiVal then Right ExpandedTemplates- else- if htmlVal then Right ImperativeState.HTML- else Right (StandardTemplates)- else Right ImperativeState.HTML- return- (FullConfig{resolution = resolutionVal, outputFilename = outputVal,- inputUrl = inputVal, runMode = runModeVal,- paper = paperVal, vector = vectorVal,- copy = copyVal >>= (return . (cwd </>)),- mainPath = cwd ++ (if os=="linux" then "" else "\\"), server = Nothing})- -{-DHUN| main entry point of mediawiki2latex DHUN-}+ featuredVal <- atMostOne featuredPredicate featuredOption o+ case featuredVal of+ Just x -> case+ (reads ("(" ++ (replace2 x ":" ",") ++ ")")) ::+ [((Integer, Integer), String)]+ of+ [((s, e), _)] | (s <= e) ->+ return+ FullConfig{ImperativeState.headers = Nothing,+ resolution = 300, outputFilename = "",+ inputUrl = "", runMode = ImperativeState.HTML,+ paper = "A4", vector = False,+ ImperativeState.copy = Nothing, mainPath = "",+ server = Nothing, selfTest = Just (s, e),+ outputType = PlainPDF, compile = Nothing,+ imgctrb = Nothing}+ _ -> Left (NotIntegerPairError featuredOption)+ _ -> case serverVal of+ Just x -> case reads x of+ [(z, _)] -> return+ FullConfig{ImperativeState.headers = Nothing,+ resolution = 300, outputFilename = "",+ inputUrl = "",+ runMode = ImperativeState.HTML,+ paper = "A4", vector = False,+ ImperativeState.copy = Nothing,+ mainPath = "", server = Just z,+ outputType = PlainPDF,+ selfTest = Nothing, compile = Nothing,+ imgctrb = Nothing}+ _ -> Left (NotIntegerError serverOption)+ _ -> do hexVal <- atMostOne hexPredicate hexen o+ case hexVal of+ Just x -> do return ((read . unhex) x)+ _ -> do resolutionOpt <- atMostOne resolutionPredicate+ resolutionOption+ o+ resolutionVal <- case resolutionOpt of+ (Just x) -> case reads x of+ [(z, _)] -> Right z+ _ -> Left+ (NotIntegerError+ resolutionOption)+ _ -> Right defaultResolution+ outputVal <- exactlyOne outputPredicate output o+ inputVal <- exactlyOne inputPredicate url o+ templatesVal <- atMostOne templatesPredicate templates o+ headersVal <- atMostOne headersPredicate templates o+ copyVal <- atMostOne copyPredicate copyOption o+ paperOpt <- atMostOne paperPredicate paperOption o+ paperVal <- case paperOpt of+ Just x -> if+ x `elem`+ ["A4", "A5", "B5", "letter",+ "legal", "executive"]+ then Right x else+ Left PaperError+ _ -> Right defaultPaper+ let mediaWikiVal = (MediaWiki `elem` o)+ let bookModeVal = (BookMode `elem` o)+ let htmlVal = (Main.HTML `elem` o)+ let zipVal = (Main.Zip `elem` o)+ let epubVal = (Main.EPub `elem` o)+ let odtVal = (Main.Odt `elem` o)+ let temVal = (Main.InternalTemplates `elem` o)+ let vectorVal = (Main.Vector `elem` o)+ let mysum+ = (boolToInt temVal) + (boolToInt mediaWikiVal) ++ (boolToInt htmlVal)+ + (maybeToInt templatesVal)+ + (boolToInt bookModeVal)+ if mysum > 1 then Left ToManyOptionsError else Right ()+ if+ ((boolToInt zipVal) + (boolToInt epubVal) ++ (boolToInt odtVal))+ > (1 :: Integer)+ then Left ToManyOutputOptionsError else Right ()+ runModeVal <- if mysum == (1 :: Integer) then+ case templatesVal of+ Just xx -> Right (UserTemplateFile xx)+ _ -> if mediaWikiVal then+ Right ExpandedTemplates else+ if htmlVal then+ Right ImperativeState.HTML else+ if bookModeVal then+ Right ImperativeState.Book+ else+ Right (StandardTemplates)+ else Right ImperativeState.HTML+ return+ (FullConfig{ImperativeState.headers =+ headersVal >>= (return . (cwd </>)),+ resolution = resolutionVal,+ selfTest = Nothing,+ outputFilename = outputVal,+ inputUrl = inputVal, runMode = runModeVal,+ paper = paperVal, vector = vectorVal,+ copy = copyVal >>= (return . (cwd </>)),+ mainPath =+ cwd ++ (if os == "linux" then "" else "\\"),+ server = Nothing,+ outputType =+ if zipVal then ZipArchive else+ if epubVal then EPubFile else+ if odtVal then OdtFile else PlainPDF,+ compile = Nothing, imgctrb = Nothing}) +{-| main entry point of mediawiki2latex -}+ main :: IO () main = do a <- getArgs o <- compilerOpts a printVersion o+ stz <- imperativeStateZero cwd <- getCurrentDirectory case (checkOpts cwd (fst o)) of- Right x -> case (server x) of- Just zz -> serve zz- _ -> do (xx, _) <- (runStateT (runErrorT (All.all x))- imperativeStateZero)- case xx of- Left n -> print n- _ -> return ()+ Right x -> case (compile x) of+ Just dir -> do _ <- (runStateT (runExceptT (runCompile dir)) stz)+ return ()+ _ -> case (imgctrb x) of+ Just dir -> do _ <- (runStateT (runExceptT (runCtrb dir)) stz)+ return ()+ _ -> case (server x) of+ Just zz -> serve zz+ _ -> do print x+ (xx, _) <- (runStateT (runExceptT (All.all x))+ stz)+ case xx of+ Left n -> print n+ _ -> return () Left y -> print y return ()--