packages feed

expand (empty) → 0.0.1

raw patch · 26 files changed

+1292/−0 lines, 26 filesdep +AspectAGdep +HListdep +basesetup-changed

Dependencies added: AspectAG, HList, base, murder, uu-parsinglib

Files

+ LICENSE view
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ examples/.svn/all-wcprops view
@@ -0,0 +1,17 @@+K 25+svn:wc:ra_dav:version-url+V 65+/repos/project.STEC.MarcosViera/!svn/ver/676/libs/expand/examples+END+output.html+K 25+svn:wc:ra_dav:version-url+V 77+/repos/project.STEC.MarcosViera/!svn/ver/676/libs/expand/examples/output.html+END+inputLatex+K 25+svn:wc:ra_dav:version-url+V 76+/repos/project.STEC.MarcosViera/!svn/ver/676/libs/expand/examples/inputLatex+END
+ examples/.svn/entries view
@@ -0,0 +1,96 @@+10++dir+689+https://svn.science.uu.nl/repos/project.STEC.MarcosViera/libs/expand/examples+https://svn.science.uu.nl/repos/project.STEC.MarcosViera++++2013-09-13T11:03:12.643054Z+674+3682536+++++++++++++++797e81ee-af45-11dd-a060-e3cdf63a9eb3++output.html+file+++++2013-09-17T17:24:27.146282Z+e367072571addb533c444f1db201d908+2013-09-13T11:03:12.643054Z+674+3682536++++++++++++++++++++++4362++inputLatex+file+++++2013-09-17T17:24:27.146282Z+f0f4547c21a99251009630452fd1805c+2013-09-12T10:45:49.557795Z+664+3682536++++++++++++++++++++++4496+
+ examples/.svn/text-base/inputLatex.svn-base view
@@ -0,0 +1,43 @@+\section{\plain{Introduction}}+\begin{paragraph}+    \plain{Iam id ipsum absurdum, maximum malum neglegi. Ut id aliis narrare gestiant? Ergo hoc quidem apparet, nos } \textbf{\plain{ad agendum }}esse natos. Expressa vero in iis aetatibus, quae iam confirmatae sunt. Parvi enim primo ortu sic iacent, tamquam omnino sine animo sint. Pauca mutat vel plura sane; An me, inquam, nisi te audire vellem, censes haec dicturum fuisse? Si verbum sequimur, primum longius verbum praepositum quam bonum. }+\end{paragraph}++\tableofcontents++\subsection{\plain{subintroduction}}+\begin{paragraph}+    \plain{Sic enim censent, oportunitatis esse beate vivere. A primo, ut opinor, animantium ortu petitur origo summi boni. Nam memini etiam quae nolo, oblivisci non possum quae volo. In his igitur partibus duabus nihil erat, quod Zeno commutare gestiret. Sed erat aequius Triarium aliquid de dissensione nostra iudicare. Idemque diviserunt naturam hominis in animum et corpus. Quid enim possumus hoc agere divinius?}+\end{paragraph}++\begin{paragraph}+    \plain{Sic enim censent, oportunitatis esse beate vivere. A primo, ut opinor, animantium ortu petitur origo summi boni. Nam memini etiam quae nolo, oblivisci non possum quae volo. In his igitur partibus duabus nihil erat, quod Zeno commutare gestiret. Sed erat aequius Triarium aliquid de dissensione nostra iudicare. Idemque diviserunt naturam hominis in animum et corpus. Quid enim possumus hoc agere divinius?}+\end{paragraph}++\begin{paragraph}+    \plain{Sic enim censent, oportunitatis esse beate vivere. A primo, ut opinor, animantium ortu petitur origo summi boni. Nam memini etiam quae nolo, oblivisci non possum quae volo. In his igitur partibus duabus nihil erat, quod Zeno commutare gestiret. Sed erat aequius Triarium aliquid de dissensione nostra iudicare. Idemque diviserunt naturam hominis in animum et corpus. Quid enim possumus hoc agere divinius?}+\end{paragraph}++\begin{paragraph}+    \plain{Cum audissem Antiochum, Brute, ut solebam, cum M. Utrum igitur tibi litteram videor an totas paginas commovere? Nonne videmus quanta perturbatio rerum omnium consequatur, quanta confusio? Multoque hoc melius nos veriusque quam Stoici. Deinde disputat, quod cuiusque generis animantium statui deceat extremum. Plane idem, inquit, et maxima quidem, qua fieri nulla maior potest. Sed non sunt in eo genere tantae commoditates corporis tamque productae temporibus tamque multae. Omnes enim iucundum motum, quo sensus hilaretur. }+\end{paragraph}++\subsection{\plain{subintroduction}}+\begin{paragraph}+    \plain{Ita ne hoc quidem modo paria peccata sunt. Summum ením bonum exposuit vacuitatem doloris; Aliter enim explicari, quod quaeritur, non potest. Callipho ad virtutem nihil adiunxit nisi voluptatem, Diodorus vacuitatem doloris. Non enim, si omnia non sequebatur, idcirco non erat ortus illinc. Sed hoc sane concedamus. Qui non moveatur et offensione turpitudinis et comprobatione honestatis? Sed quanta sit alias, nunc tantum possitne esse tanta. Mihi vero, inquit, placet agi subtilius et, ut ipse dixisti, pressius. At ille pellit, qui permulcet sensum voluptate. }+\end{paragraph}+++\subsubsection{\plain{Details}}+\begin{paragraph}+    \plain{Lorem ipsum dolor sit amet, consectetur adipiscing elit. Ab hoc autem quaedam non melius quam veteres, quaedam omnino relicta. Rationis enim perfectio est virtus; Nunc haec primum fortasse audientis servire debemus. Non enim solum Torquatus dixit quid sentiret, sed etiam cur. Paulum, cum regem Persem captum adduceret, eodem flumine invectio? Quodsi ipsam honestatem undique pertectam atque absolutam.++Mihi enim erit isdem istis fortasse iam utendum. Illa videamus, quae a te de amicitia dicta sunt. Utinam quidem dicerent alium alio beatiorem! Iam ruinas videres. Quam ob rem tandem, inquit, non satisfacit?++Equidem, sed audistine modo de Carneade? Tamen a proposito, inquam, aberramus.++Nos vero, inquit ille; Utilitatis causa amicitia est quaesita. Quamquam tu hanc copiosiorem etiam soles dicere. Nunc omni virtuti vitium contrario nomine opponitur.++Prioris generis est docilitas, memoria; Duo Reges: constructio interrete. Inde igitur, inquit, ordiendum est. Nam illud vehementer repugnat, eundem beatum esse et multis malis oppressum. Sed tu istuc dixti bene Latine, parum plane. Atque ab his initiis profecti omnium virtutum et originem et progressionem persecuti sunt. Quod vestri non item. Cur tantas regiones barbarorum pedibus obiit, tot maria transmisit?+}+\end{paragraph}
+ examples/.svn/text-base/output.html.svn-base view
@@ -0,0 +1,24 @@+<h1 id="[1]">1 Introduction</h1>+<p>Iam id ipsum absurdum, maximum malum neglegi. Ut id aliis narrare gestiant? Ergo hoc quidem apparet, nos <b>ad agendum </b>natos. Expressa vero in iis aetatibus, quae iam confirmatae sunt. Parvi enim primo ortu sic iacent, tamquam omnino sine animo sint. Pauca mutat vel plura sane; An me, inquam, nisi te audire vellem, censes haec dicturum fuisse? Si verbum sequimur, primum longius verbum praepositum quam bonum. </p>+<a href=#[1]>1 Introduction</a><br />+<a href=#[1,1]>1.1 subintroduction</a><br />+<a href=#[1,2]>1.2 subintroduction</a><br />+<a href=#[1,2,1]>1.2.1 Details</a><br />+<h2 id="[1,1]">1.1 subintroduction</h2>+<p>Sic enim censent, oportunitatis esse beate vivere. A primo, ut opinor, animantium ortu petitur origo summi boni. Nam memini etiam quae nolo, oblivisci non possum quae volo. In his igitur partibus duabus nihil erat, quod Zeno commutare gestiret. Sed erat aequius Triarium aliquid de dissensione nostra iudicare. Idemque diviserunt naturam hominis in animum et corpus. Quid enim possumus hoc agere divinius?</p>+<p>Sic enim censent, oportunitatis esse beate vivere. A primo, ut opinor, animantium ortu petitur origo summi boni. Nam memini etiam quae nolo, oblivisci non possum quae volo. In his igitur partibus duabus nihil erat, quod Zeno commutare gestiret. Sed erat aequius Triarium aliquid de dissensione nostra iudicare. Idemque diviserunt naturam hominis in animum et corpus. Quid enim possumus hoc agere divinius?</p>+<p>Sic enim censent, oportunitatis esse beate vivere. A primo, ut opinor, animantium ortu petitur origo summi boni. Nam memini etiam quae nolo, oblivisci non possum quae volo. In his igitur partibus duabus nihil erat, quod Zeno commutare gestiret. Sed erat aequius Triarium aliquid de dissensione nostra iudicare. Idemque diviserunt naturam hominis in animum et corpus. Quid enim possumus hoc agere divinius?</p>+<p>Cum audissem Antiochum, Brute, ut solebam, cum M. Utrum igitur tibi litteram videor an totas paginas commovere? Nonne videmus quanta perturbatio rerum omnium consequatur, quanta confusio? Multoque hoc melius nos veriusque quam Stoici. Deinde disputat, quod cuiusque generis animantium statui deceat extremum. Plane idem, inquit, et maxima quidem, qua fieri nulla maior potest. Sed non sunt in eo genere tantae commoditates corporis tamque productae temporibus tamque multae. Omnes enim iucundum motum, quo sensus hilaretur. </p>+<h2 id="[1,2]">1.2 subintroduction</h2>+<p>Ita ne hoc quidem modo paria peccata sunt. Summum ením bonum exposuit vacuitatem doloris; Aliter enim explicari, quod quaeritur, non potest. Callipho ad virtutem nihil adiunxit nisi voluptatem, Diodorus vacuitatem doloris. Non enim, si omnia non sequebatur, idcirco non erat ortus illinc. Sed hoc sane concedamus. Qui non moveatur et offensione turpitudinis et comprobatione honestatis? Sed quanta sit alias, nunc tantum possitne esse tanta. Mihi vero, inquit, placet agi subtilius et, ut ipse dixisti, pressius. At ille pellit, qui permulcet sensum voluptate. </p>+<h3 id="[1,2,1]">1.2.1 Details</h3>+<p>Lorem ipsum dolor sit amet, consectetur adipiscing elit. Ab hoc autem quaedam non melius quam veteres, quaedam omnino relicta. Rationis enim perfectio est virtus; Nunc haec primum fortasse audientis servire debemus. Non enim solum Torquatus dixit quid sentiret, sed etiam cur. Paulum, cum regem Persem captum adduceret, eodem flumine invectio? Quodsi ipsam honestatem undique pertectam atque absolutam.++Mihi enim erit isdem istis fortasse iam utendum. Illa videamus, quae a te de amicitia dicta sunt. Utinam quidem dicerent alium alio beatiorem! Iam ruinas videres. Quam ob rem tandem, inquit, non satisfacit?++Equidem, sed audistine modo de Carneade? Tamen a proposito, inquam, aberramus.++Nos vero, inquit ille; Utilitatis causa amicitia est quaesita. Quamquam tu hanc copiosiorem etiam soles dicere. Nunc omni virtuti vitium contrario nomine opponitur.++Prioris generis est docilitas, memoria; Duo Reges: constructio interrete. Inde igitur, inquit, ordiendum est. Nam illud vehementer repugnat, eundem beatum esse et multis malis oppressum. Sed tu istuc dixti bene Latine, parum plane. Atque ab his initiis profecti omnium virtutum et originem et progressionem persecuti sunt. Quod vestri non item. Cur tantas regiones barbarorum pedibus obiit, tot maria transmisit?+</p>
+ examples/inputLatex view
@@ -0,0 +1,43 @@+\section{\plain{Introduction}}+\begin{paragraph}+    \plain{Iam id ipsum absurdum, maximum malum neglegi. Ut id aliis narrare gestiant? Ergo hoc quidem apparet, nos } \textbf{\plain{ad agendum }}esse natos. Expressa vero in iis aetatibus, quae iam confirmatae sunt. Parvi enim primo ortu sic iacent, tamquam omnino sine animo sint. Pauca mutat vel plura sane; An me, inquam, nisi te audire vellem, censes haec dicturum fuisse? Si verbum sequimur, primum longius verbum praepositum quam bonum. }+\end{paragraph}++\tableofcontents++\subsection{\plain{subintroduction}}+\begin{paragraph}+    \plain{Sic enim censent, oportunitatis esse beate vivere. A primo, ut opinor, animantium ortu petitur origo summi boni. Nam memini etiam quae nolo, oblivisci non possum quae volo. In his igitur partibus duabus nihil erat, quod Zeno commutare gestiret. Sed erat aequius Triarium aliquid de dissensione nostra iudicare. Idemque diviserunt naturam hominis in animum et corpus. Quid enim possumus hoc agere divinius?}+\end{paragraph}++\begin{paragraph}+    \plain{Sic enim censent, oportunitatis esse beate vivere. A primo, ut opinor, animantium ortu petitur origo summi boni. Nam memini etiam quae nolo, oblivisci non possum quae volo. In his igitur partibus duabus nihil erat, quod Zeno commutare gestiret. Sed erat aequius Triarium aliquid de dissensione nostra iudicare. Idemque diviserunt naturam hominis in animum et corpus. Quid enim possumus hoc agere divinius?}+\end{paragraph}++\begin{paragraph}+    \plain{Sic enim censent, oportunitatis esse beate vivere. A primo, ut opinor, animantium ortu petitur origo summi boni. Nam memini etiam quae nolo, oblivisci non possum quae volo. In his igitur partibus duabus nihil erat, quod Zeno commutare gestiret. Sed erat aequius Triarium aliquid de dissensione nostra iudicare. Idemque diviserunt naturam hominis in animum et corpus. Quid enim possumus hoc agere divinius?}+\end{paragraph}++\begin{paragraph}+    \plain{Cum audissem Antiochum, Brute, ut solebam, cum M. Utrum igitur tibi litteram videor an totas paginas commovere? Nonne videmus quanta perturbatio rerum omnium consequatur, quanta confusio? Multoque hoc melius nos veriusque quam Stoici. Deinde disputat, quod cuiusque generis animantium statui deceat extremum. Plane idem, inquit, et maxima quidem, qua fieri nulla maior potest. Sed non sunt in eo genere tantae commoditates corporis tamque productae temporibus tamque multae. Omnes enim iucundum motum, quo sensus hilaretur. }+\end{paragraph}++\subsection{\plain{subintroduction}}+\begin{paragraph}+    \plain{Ita ne hoc quidem modo paria peccata sunt. Summum ením bonum exposuit vacuitatem doloris; Aliter enim explicari, quod quaeritur, non potest. Callipho ad virtutem nihil adiunxit nisi voluptatem, Diodorus vacuitatem doloris. Non enim, si omnia non sequebatur, idcirco non erat ortus illinc. Sed hoc sane concedamus. Qui non moveatur et offensione turpitudinis et comprobatione honestatis? Sed quanta sit alias, nunc tantum possitne esse tanta. Mihi vero, inquit, placet agi subtilius et, ut ipse dixisti, pressius. At ille pellit, qui permulcet sensum voluptate. }+\end{paragraph}+++\subsubsection{\plain{Details}}+\begin{paragraph}+    \plain{Lorem ipsum dolor sit amet, consectetur adipiscing elit. Ab hoc autem quaedam non melius quam veteres, quaedam omnino relicta. Rationis enim perfectio est virtus; Nunc haec primum fortasse audientis servire debemus. Non enim solum Torquatus dixit quid sentiret, sed etiam cur. Paulum, cum regem Persem captum adduceret, eodem flumine invectio? Quodsi ipsam honestatem undique pertectam atque absolutam.++Mihi enim erit isdem istis fortasse iam utendum. Illa videamus, quae a te de amicitia dicta sunt. Utinam quidem dicerent alium alio beatiorem! Iam ruinas videres. Quam ob rem tandem, inquit, non satisfacit?++Equidem, sed audistine modo de Carneade? Tamen a proposito, inquam, aberramus.++Nos vero, inquit ille; Utilitatis causa amicitia est quaesita. Quamquam tu hanc copiosiorem etiam soles dicere. Nunc omni virtuti vitium contrario nomine opponitur.++Prioris generis est docilitas, memoria; Duo Reges: constructio interrete. Inde igitur, inquit, ordiendum est. Nam illud vehementer repugnat, eundem beatum esse et multis malis oppressum. Sed tu istuc dixti bene Latine, parum plane. Atque ab his initiis profecti omnium virtutum et originem et progressionem persecuti sunt. Quod vestri non item. Cur tantas regiones barbarorum pedibus obiit, tot maria transmisit?+}+\end{paragraph}
+ examples/output.html view
@@ -0,0 +1,24 @@+<h1 id="[1]">1 Introduction</h1>+<p>Iam id ipsum absurdum, maximum malum neglegi. Ut id aliis narrare gestiant? Ergo hoc quidem apparet, nos <b>ad agendum </b>natos. Expressa vero in iis aetatibus, quae iam confirmatae sunt. Parvi enim primo ortu sic iacent, tamquam omnino sine animo sint. Pauca mutat vel plura sane; An me, inquam, nisi te audire vellem, censes haec dicturum fuisse? Si verbum sequimur, primum longius verbum praepositum quam bonum. </p>+<a href=#[1]>1 Introduction</a><br />+<a href=#[1,1]>1.1 subintroduction</a><br />+<a href=#[1,2]>1.2 subintroduction</a><br />+<a href=#[1,2,1]>1.2.1 Details</a><br />+<h2 id="[1,1]">1.1 subintroduction</h2>+<p>Sic enim censent, oportunitatis esse beate vivere. A primo, ut opinor, animantium ortu petitur origo summi boni. Nam memini etiam quae nolo, oblivisci non possum quae volo. In his igitur partibus duabus nihil erat, quod Zeno commutare gestiret. Sed erat aequius Triarium aliquid de dissensione nostra iudicare. Idemque diviserunt naturam hominis in animum et corpus. Quid enim possumus hoc agere divinius?</p>+<p>Sic enim censent, oportunitatis esse beate vivere. A primo, ut opinor, animantium ortu petitur origo summi boni. Nam memini etiam quae nolo, oblivisci non possum quae volo. In his igitur partibus duabus nihil erat, quod Zeno commutare gestiret. Sed erat aequius Triarium aliquid de dissensione nostra iudicare. Idemque diviserunt naturam hominis in animum et corpus. Quid enim possumus hoc agere divinius?</p>+<p>Sic enim censent, oportunitatis esse beate vivere. A primo, ut opinor, animantium ortu petitur origo summi boni. Nam memini etiam quae nolo, oblivisci non possum quae volo. In his igitur partibus duabus nihil erat, quod Zeno commutare gestiret. Sed erat aequius Triarium aliquid de dissensione nostra iudicare. Idemque diviserunt naturam hominis in animum et corpus. Quid enim possumus hoc agere divinius?</p>+<p>Cum audissem Antiochum, Brute, ut solebam, cum M. Utrum igitur tibi litteram videor an totas paginas commovere? Nonne videmus quanta perturbatio rerum omnium consequatur, quanta confusio? Multoque hoc melius nos veriusque quam Stoici. Deinde disputat, quod cuiusque generis animantium statui deceat extremum. Plane idem, inquit, et maxima quidem, qua fieri nulla maior potest. Sed non sunt in eo genere tantae commoditates corporis tamque productae temporibus tamque multae. Omnes enim iucundum motum, quo sensus hilaretur. </p>+<h2 id="[1,2]">1.2 subintroduction</h2>+<p>Ita ne hoc quidem modo paria peccata sunt. Summum ením bonum exposuit vacuitatem doloris; Aliter enim explicari, quod quaeritur, non potest. Callipho ad virtutem nihil adiunxit nisi voluptatem, Diodorus vacuitatem doloris. Non enim, si omnia non sequebatur, idcirco non erat ortus illinc. Sed hoc sane concedamus. Qui non moveatur et offensione turpitudinis et comprobatione honestatis? Sed quanta sit alias, nunc tantum possitne esse tanta. Mihi vero, inquit, placet agi subtilius et, ut ipse dixisti, pressius. At ille pellit, qui permulcet sensum voluptate. </p>+<h3 id="[1,2,1]">1.2.1 Details</h3>+<p>Lorem ipsum dolor sit amet, consectetur adipiscing elit. Ab hoc autem quaedam non melius quam veteres, quaedam omnino relicta. Rationis enim perfectio est virtus; Nunc haec primum fortasse audientis servire debemus. Non enim solum Torquatus dixit quid sentiret, sed etiam cur. Paulum, cum regem Persem captum adduceret, eodem flumine invectio? Quodsi ipsam honestatem undique pertectam atque absolutam.++Mihi enim erit isdem istis fortasse iam utendum. Illa videamus, quae a te de amicitia dicta sunt. Utinam quidem dicerent alium alio beatiorem! Iam ruinas videres. Quam ob rem tandem, inquit, non satisfacit?++Equidem, sed audistine modo de Carneade? Tamen a proposito, inquam, aberramus.++Nos vero, inquit ille; Utilitatis causa amicitia est quaesita. Quamquam tu hanc copiosiorem etiam soles dicere. Nunc omni virtuti vitium contrario nomine opponitur.++Prioris generis est docilitas, memoria; Duo Reges: constructio interrete. Inde igitur, inquit, ordiendum est. Nam illud vehementer repugnat, eundem beatum esse et multis malis oppressum. Sed tu istuc dixti bene Latine, parum plane. Atque ab his initiis profecti omnium virtutum et originem et progressionem persecuti sunt. Quod vestri non item. Cur tantas regiones barbarorum pedibus obiit, tot maria transmisit?+</p>
+ expand.cabal view
@@ -0,0 +1,21 @@+-- Initial markupconverter.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                expand+version:             0.0.1+synopsis:            Extensible Pandoc            +-- description:                  +license:             LGPL             +license-file:        LICENSE+author:              Jacco Krijnen+maintainer:          jaccokrijnen@gmail.com+-- copyright:           +category:            Text+build-type:          Simple+cabal-version:       >=1.8++library+  exposed-modules:     Testing+  -- other-modules:       +  build-depends:       base ==4.6.*, murder>=1.3.3, uu-parsinglib >= 2.7.3.4, AspectAG >= 0.3.6.1, HList>=0.2+  hs-source-dirs:      src, examples
+ src/Document/Decl.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE TemplateHaskell, EmptyDataDecls #-}+module Document.Decl where++import Language.Grammars.AspectAG+import Language.Grammars.AspectAG.Derive+++data Document = Document { blocks :: BlockL }+    deriving Show+++type BlockL = [Block]++data Block = Header    { level_header   :: Int,+                         inlines_header :: InlineL }+           | Paragraph { inlines_par  :: InlineL }+           deriving (Show)+++type InlineL = [Inline]++data Inline = Plain   { str_plainInl     :: String }+            | Bold    { inlines_boldInl :: InlineL }+            | Italics { inlines_italInl  :: InlineL }+            deriving (Show)       ++++++$(deriveAG ''Document)+$(deriveLang "Doc" [''Document, ''BlockL, ''Block, ''InlineL, ''Inline])+++-- semantics for building the AST++semAst = DocSF {+    pBlockL_Cons  = (:),+    pBlockL_Nil   = [],+    pBold         = Bold,+    pDocument     = Document,+    pHeader       = Header,+    pInlineL_Cons = (:),+    pInlineL_Nil  = [],+    pItalics      = Italics,+    pParagraph    = Paragraph,+    pPlain        = Plain+}
+ src/Document/Grammars/Html.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE Arrows, RecursiveDo, EmptyDataDecls, TemplateHaskell, PostfixOperators, FlexibleContexts #-}++module Document.Grammars.Html where++import Prelude hiding ((+), (*))+import Data.Char+import Control.Applicative++import Language.Grammars.Grammar+import Language.Grammars.Murder+import Language.Grammars.Murder.Derive+import Language.Grammars.Murder.UUParsing+import Language.Grammars.AspectAG+import Document.Decl+import Utils++-- Generate the labels used as lookup keys in the exportlist+$(csLabels  ["cs_document", "cs_blockL", "cs_paragraph", "cs_header", "cs_inline", "cs_inlineL"])++{-+-- | Recognizes a header at level x, i.e. "<hx> ... </hx>" +headerLvl :: (int -> inlines -> a)    -- ^ The semantic function +          -> Symbol inlines TNonT env -- ^ The non terminal to be recognized between the tags+          -> Int                      -- ^ The level+          -> PreProductions l env a -}+headerLvl pHeader body x = let open  = "<h"  ++ show x ++ ">"+                               close = "</h" ++ show x ++ ">"+                           in  iI (pHeader x) open body close Ii++++++-- | The grammar for a simplified version of Html+gHtml sem = proc () -> do+    rec +        document     <-addNT-< iI (pDocument sem) blockL Ii+        +        +        blockL       <-addNT-< pFoldr (pBlockL_Cons sem, pBlockL_Nil sem) $ +                                   (iI header Ii) <|> (iI paragraph Ii)+        paragraph    <-addNT-< iI (pParagraph sem) "<p>" inlineL "</p>" Ii+        header       <-addNT-< foldr1 (<|>) $ +                                   map (headerLvl (pHeader sem) inlineL) [1..6]+        +        -- this seperation is required for the inlines non-terminal+        inline       <-addNT-<  iI (pPlain   sem) "<plain>" (someExcept "<") "</plain>" Ii +                        <|>     iI (pBold    sem) "<b>"     inlineL          "</b>"     Ii+                        <|>     iI (pItalics sem) "<i>"     inlineL          "</i>"     Ii+        +        -- Multiple inlines+        inlineL      <-addNT-<  pFoldr (pInlineL_Cons sem, pInlineL_Nil sem) $+                                    iI inline Ii+        ++        +++    exportNTs -<  exportList document (   export cs_document      document+                                        . export cs_blockL        blockL+                                        . export cs_paragraph     paragraph+                                        . export cs_header        header+                                        . export cs_inline        inline+                                        . export cs_inlineL       inlineL)
+ src/Document/Grammars/Latex.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE Arrows, RecursiveDo, EmptyDataDecls, TemplateHaskell, PostfixOperators, FlexibleContexts #-}++module Document.Grammars.Latex where++import Control.Applicative++import Language.Grammars.Grammar+import Language.Grammars.Murder+import Language.Grammars.Murder.Derive+import Language.Grammars.Murder.UUParsing+import Language.Grammars.AspectAG+import Document.Decl+import Utils++$(csLabels  ["cs_document", "cs_blockL", "cs_block", "cs_paragraph", "cs_header", "cs_inline", "cs_inlineL"])+++-- The grammar is parametrised by the semantic record (sem)+gLatex sem = proc () -> do+    rec+        document     <-addNT-< iI (pDocument sem) blockL Ii+++        ------------------------------+        -- block level+        ------------------------------+        blockL       <-addNT-< pFoldr (pBlockL_Cons sem, pBlockL_Nil sem) $ +                                   iI block Ii+        +        block        <-addNT-< iI header Ii <|> iI paragraph Ii++        paragraph    <-addNT-< iI (pParagraph sem) "\\begin" "{" "paragraph" "}" +                                                   inlineL +                                                   "\\end"   "{" "paragraph" "}" Ii+        +        header       <-addNT-< let h (x, name) = iI (pHeader sem x) "\\" name "{" inlineL "}" Ii+                                   headers     = [(1,"section"), (2, "subsection"), (3, "subsubsection")]+                               in  foldr1 (<|>) (map h headers)+                                   ++        -------------------------------+        -- inline level+        -------------------------------+++        inlineL      <-addNT-< pFoldr (pInlineL_Cons sem, pInlineL_Nil sem) $+                                   iI inline Ii++        inline       <-addNT-< iI (pPlain   sem) "\\plain"  "{" (someExcept "\\&%$#_{}~^") "}" Ii+                        <|>    iI (pBold    sem) "\\textbf" "{" inlineL          "}" Ii+                        <|>    iI (pItalics sem) "\\textit" "{" inlineL          "}" Ii++        --------------------------------+        -- plain text primitives+        --------------------------------+        +        text         <-addNT-< iI       word Ii +                        <|>    iI pText word (ign space) text (ign space) Ii+        ++        let specials = "\\&%$#_{}~^"+        let wspace   = " \t"++        -- recognizes whitespace (no newlines)+        space        <-addNT-< iI id (someOf wspace) Ii+        +        -- non empty sequence of characters that are not special+        word         <-addNT-< iI (someExcept (specials ++ wspace)) Ii++{-        +    exportNTs -< exportList text id+  -}    +++    exportNTs -<  exportList document ( export cs_document      document+                                      . export cs_blockL        blockL+                                      . export cs_block         block+                                      . export cs_paragraph     paragraph+                                      . export cs_header        header+                                      . export cs_inline        inline+                                      . export cs_inlineL       inlineL)++pText w ws = w ++ " " ++ ws
+ src/Document/Grammars/Markdown.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE Arrows, RecursiveDo, EmptyDataDecls, TemplateHaskell, PostfixOperators #-}++module Document.Grammars.Markdown where++import Control.Applicative+import Prelude hiding ((+),(*))+import Language.Grammars.Grammar+import Language.Grammars.Murder+import Language.Grammars.Murder.Derive+import Language.Grammars.Murder.UUParsing+import Language.Grammars.Grammar.AG++import Document.Decl+import Utils++$(csLabels  ["cs_header", "cs_atxPrefix", "cs_atxTitle"])+++gMarkdown sem syms = proc () -> do+    +    rec +        document  <-addNT-< iI (pDocument sem) blockL Ii+++        blockL    <-addNT-< pMany $ iI block Ii++        block     <-addNT-< iI header Ii+                     <|>    iI paragraph Ii+++        -- Block level++        paragraph <-addNT-< iI concat (textLine+) (ign blankLine) Ii++        header    <-addNT-< iI ((++) . show) atxPrefix atxTitle Ii++        atxPrefix <-addNT-< fmap length $ iI (someOf "#") Ii        +        atxTitle  <-addNT-< iI (\x xs -> value x : xs) (anyExcept "#") (manyExcept "\n") "\n" Ii++++        inlineL   <-addNT-< pMany $ iI inline Ii++        -- Inline level++        inline    <-addNT-< iI bold Ii +                     <|>    iI italics Ii +                     <|>    iI plain Ii++        plain     <-addNT-< iI (\x xs x'-> value x : xs ++ [value x']) (anyExcept "*_") (someExcept "*_\n") (anyOf "\n") Ii++        bold      <-addNT-< iI "**" (someExcept "*\n") "**" Ii+                      <|>   iI "__" (someExcept "_\n") "__" Ii++        italics   <-addNT-< iI "*" (someExcept "*\n") "*" Ii+                     <|>    iI "_" (someExcept "_\n") "_" Ii+++        -- primitives+        textLine  <-addNT-< iI (\x xs -> value x : xs) (anyExcept syms) (manyExcept "\n") "\n" Ii+        blankLine <-addNT-< iI (someOf " \n\t\r") Ii+    +    exportNTs -< exportList inlineL ( export cs_header    header+                                   . export cs_atxPrefix atxPrefix +                                   . export cs_atxTitle      atxTitle)++++++++++lineChars = ['a'..'z'] ++ ['A' .. 'Z'] ++ ['0' .. '9'] ++ " ':;!@()\""+++-- Semantics for building the AST+semLine = map value++--semNewLine :: Maybe (DTerm String) -> ()+semNewLine _ = ()++semHeaderAtx :: [DTerm String] -> String -> Block+semHeaderAtx x str = let hlevel = length x+                     in  Header hlevel [Plain str]++semHeaderSetext :: String -> (DTerm String) -> Block+semHeaderSetext str hsym = let hlevel = if (value hsym) == "=" then 1 else 2+                           in  Header hlevel [Plain str]+++
+ src/Document/Semantics/Html.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE TemplateHaskell, EmptyDataDecls, NoMonomorphismRestriction #-}+module Document.Semantics.Html where++import Control.Monad++import Data.HList.Label4+import Data.HList.TypeEqGeneric1+import Data.HList.TypeCastGeneric1++import Language.Grammars.AspectAG+import Language.Grammars.AspectAG.Derive++import Document.Decl++$(attLabels ["html"])++-- Document production+document_html = syn html $+    do blocks <- at ch_blocks+       return $ blocks # html++++-- Blocks productions+blockLnil_html = syn html $ return ""++blockLcons_html = syn html $+    do block  <- at ch_hd_BlockL_Cons+       blocks <- at ch_tl_BlockL_Cons+       return $ block # html ++ blocks # html+++--blockLcons_html = use html (nt_BlockL .*. HNil) (++) ""++-- Block productions+header_html = syn html $+    do level  <- at ch_level_header+       inls   <- at ch_inlines_header+       return $ "<h" ++ show level ++ ">" +                 ++ inls # html+                 ++ "</h" ++ show level ++ ">"+                 ++ "\n"++paragraph_html = syn html $+    do inls <- at ch_inlines_par+       return $ "<p>" +              ++ inls # html+              ++ "</p>"+              ++ "\n"++++-- Inline productions++inlineLnil_html = syn html $ return ""+inlineLcons_html = syn html $+    do inl  <- at ch_hd_InlineL_Cons+       inls <- at ch_tl_InlineL_Cons+       return $ inl # html ++ inls # html+++plain_html = syn html $ at ch_str_plainInl+++bold_html  = syn html $ +                    do inls <- at ch_inlines_boldInl+                       return $ "<b>" +                              ++ inls # html +                              ++ "</b>"++italics_html  = syn html $ +                    do inls <- at ch_inlines_italInl+                       return $ "<i>" +                              ++ inls # html+                              ++ "</i>"+++++-----------------------+-- building the record++{- +aspDocument     = document_html+aspBlockL_Nil   = blockLnil_html+aspBlockL_Cons  = blockLcons_html+aspHeader       = header_html+aspParagraph    = paragraph_html+aspInlineL_Nil  = inlineLnil_html+aspInlineL_Cons = inlineLcons_html+aspPlain        = plain_html+aspBold         = bold_html+aspItalics      = italics_html+-}+semHtml = mkDoc' blockLcons_html blockLnil_html bold_html+                 document_html header_html inlineLcons_html inlineLnil_html+                 italics_html paragraph_html plain_html+++-- slightly edited mkDoc (from TH splice)+mkDoc'+      _BlockL_Cons+      _BlockL_Nil+      _Bold+      _Document+      _Header+      _InlineL_Cons+      _InlineL_Nil+      _Italics+      _Paragraph+      _Plain+      = DocSF+          {pBlockL_Cons = semP_BlockL_Cons _BlockL_Cons,+           pBlockL_Nil = semP_BlockL_Nil _BlockL_Nil, pBold = semP_Bold _Bold,+           pDocument = semP_Document _Document, pHeader = semP_Header _Header . sem_Lit,+           pInlineL_Cons = semP_InlineL_Cons _InlineL_Cons,+           pInlineL_Nil = semP_InlineL_Nil _InlineL_Nil,+           pItalics = semP_Italics _Italics,+           pParagraph = semP_Paragraph _Paragraph, pPlain = semP_Plain _Plain . sem_Lit}++++{- -- OLD, not extensible+semHtmlNotExtensible :: Document -> String+semHtmlNotExtensible doc = sem_Document asp_html doc () # html+++++------------------------------------------+-- Initial aspect html (synthesized html)+------------------------------------------++-- The aspect is a heterogenous list of pairs of production and rule+asp_html =  (p_Document     .=. document_html) +         .*. (p_BlockL_Nil   .=. blockLnil_html)+         .*. (p_BlockL_Cons  .=. blockLcons_html)+         .*. (p_Header       .=. header_html) +         .*. (p_Paragraph    .=. paragraph_html)+         .*. (p_InlineL_Nil  .=. inlineLnil_html)+         .*. (p_InlineL_Cons .=. inlineLcons_html)+         .*. (p_Plain        .=. plain_html)+         .*. (p_Bold         .=. bold_html) +         .*. (p_Italics      .=. italics_html)+         .*. emptyRecord+-}
+ src/Document/Semantics/HtmlNumberedHeaders.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE TemplateHaskell, EmptyDataDecls, NoMonomorphismRestriction #-}+module Document.Semantics.HtmlNumberedHeaders where++import Data.HList.Label4+import Data.HList.TypeEqGeneric1+import Data.HList.TypeCastGeneric1+import Language.Grammars.AspectAG+import Language.Grammars.AspectAG.Derive++import Document.Decl+import Document.Semantics.Html+import Document.Semantics.NumberedHeaders+++-- | Redefines the html attribute for headers so that it will print+--   the associated number+header_html' = synmodM html $ +    do level  <- at ch_level_header+       inls   <- at ch_inlines_header+       loc    <- at loc+       let num = loc # headerNum+       return $ "<h" ++ show level  ++ ">" +                 ++ formatNH num ++ " "+                 ++ inls # html+                 ++ "</h" ++ show level ++ ">"+                 ++ "\n"+++-- building the record++semHtml' = mkDoc' (default_cHeaderNum       `ext` blockLcons_html)+                  (default_cHeaderNum       `ext` blockLnil_html)+                  bold_html         +                  (document_cHeaderNum  `ext` document_html)+                  (header_headerNum    `ext` header_cHeaderNum +                                        `ext` header_html'+                                        `ext` header_html)+                  inlineLcons_html +                  inlineLnil_html+                  italics_html +                  (default_cHeaderNum       `ext` paragraph_html )+                  plain_html
+ src/Document/Semantics/NumberedHeaders.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE TemplateHaskell, EmptyDataDecls, NoMonomorphismRestriction #-}+module Document.Semantics.NumberedHeaders where++import Data.List+import Data.HList.Label4+import Data.HList.TypeEqGeneric1+import Data.HList.TypeCastGeneric1++import Language.Grammars.AspectAG+import Language.Grammars.AspectAG.Derive++import Document.Decl+++-- To correctly number every header, we chain a value of type [Int] through the tree,+-- of which the elements correspond to the current section. For example, section 1.3.4+-- is represented as [1, 3, 4].+$(attLabels ["cHeaderNum", "headerNum"])++++-- | Computes the header number from the level and its parent header number.+updateHeaderNum :: Int -> [Int] -> [Int]+updateHeaderNum level par = zipWith (+) par' (zeros ++ [1]) +    where par'  = par ++ repeat 0+          zeros = replicate (level - 1) 0++-- | Formats a header number, i.e. [3,1,4] becomes "3.1.4"+formatNH :: [Int] -> String+formatNH = intercalate "." . map show           +++++++cHeaderNum_NTs = nt_BlockL .*. nt_Block .*. hNil+++-- The general rule for the chained attribute+default_cHeaderNum = chain cHeaderNum cHeaderNum_NTs++document_cHeaderNum = inh cHeaderNum cHeaderNum_NTs $ return (ch_blocks .=. ([] :: [Int]) .*. emptyRecord)++-- Specific rule to update the header counter (if header level is 2)+header_cHeaderNum = syn cHeaderNum $+                        do loc   <- at loc+                           return $ loc # headerNum+++++header_headerNum = locdefM headerNum $+                        do lhs   <- at lhs+                           level <- at ch_level_header+                           return $ updateHeaderNum level (lhs # cHeaderNum)++++{- -- OLD, not extensible+asp_cHeaderNum =  (p_Document    .=. default_cHeaderNum)+              .*. (p_BlockL_Cons .=. default_cHeaderNum)+              .*. (p_BlockL_Nil  .=. default_cHeaderNum)+              .*. (p_Paragraph   .=. default_cHeaderNum)+              .*. (p_Header      .=. header_cHeaderNum)+              .*. (p_InlineL_Nil  .=. emptyRule)+              .*. (p_InlineL_Cons .=. emptyRule)+              .*. (p_Plain        .=. emptyRule)+              .*. (p_Bold         .=. emptyRule) +              .*. (p_Italics      .=. emptyRule)+              .*. emptyRecord+++semHeaderNum :: Document -> Int+semHeaderNum doc = sem_Document asp_cHeaderNum doc (cHeaderNum .=. 1 .*. emptyRecord) # cHeaderNum+-}
+ src/HRef/Decl.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE TemplateHaskell, EmptyDataDecls #-}+module HRef.Decl where++import Document.Decl++import Language.Grammars.AspectAG+import Language.Grammars.AspectAG.Derive++++data EXT_Inline = Href { href_address :: String, href_description :: String }++$(extendAG ''EXT_Inline [ ])+$(deriveLang "DocHref" [''EXT_Inline])++semAstHref = DocHrefSF {+	pHref = const Plain+}
+ src/HRef/Grammars/Html.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE Arrows #-}++module HRef.Grammars.Html where++import Language.Grammars.Grammar+import Language.Grammars.Murder++import Document.Grammars.Html+import Document.Decl+import HRef.Decl++import Utils+++gHtmlHref sem = proc imported -> do+    let inline = getNT cs_inline imported+    +    _ <-addProds-< (inline,  +    				iI (pHref sem) "<a href=\"" (someExcept "\"") "\">" (someExcept "<") "</a>" Ii)+    +    exportNTs -< imported
+ src/HRef/Semantics/Html.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE TemplateHaskell, EmptyDataDecls, NoMonomorphismRestriction #-}+module HRef.Semantics.Html where++import Data.HList.Label4+import Data.HList.TypeEqGeneric1+import Data.HList.TypeCastGeneric1++import Language.Grammars.AspectAG++import HRef.Decl+import Document.Semantics.Html+++href_html  = syn html $ +                    do adr   <- at ch_href_address+                       descr <- at ch_href_description+                       return $ "<a href = " ++ adr ++ ">" +                              ++ descr +                              ++ "</a>"+++aspHref = href_html++semHtmlHref = mkDocHref aspHref
+ src/Preprocessors.hs view
@@ -0,0 +1,20 @@+module Preprocessors (preprocessHtml) where++import Data.Char++-- | Inserts "<plain>" and "</plain>" to escape plain text+preprocessHtml :: String -> String+preprocessHtml ""                 = ""+preprocessHtml ('>':xs) +             | plainPrefix xs = let (text, xs') = getPlain xs+                                in  "><plain>" ++ text ++ "</plain>" ++ preprocessHtml xs'+preprocessHtml (x  :xs) = x:(preprocessHtml xs) +++plainPrefix :: String -> Bool+plainPrefix xs = case dropWhile isSpace xs of+                     (x:_) -> x /= '<'+                     _     -> False++getPlain :: String -> (String, String)+getPlain xs = (takeWhile (/= '<') xs, dropWhile (/= '<') xs)  
+ src/Testing.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE RankNTypes #-}++module Testing (module Utils,+                module Document.Decl,+                module HRef.Decl,+                module HRef.Grammars.Html,+                module Document.Semantics.Html,+                module HRef.Semantics.Html,+                module Document.Semantics.NumberedHeaders,+                module Document.Semantics.HtmlNumberedHeaders,+                module Preprocessors,+                module Language.Grammars.AspectAG,+                module Document.Grammars.Latex,+                module Toc.Semantics.Toc,+                module Testing) where++import Control.Applicative++import Utils+import Document.Decl+import HRef.Decl+import Toc.Decl+import Document.Grammars.Html+import HRef.Grammars.Html+import Document.Grammars.Markdown+import Toc.Grammars.Latex+import Document.Grammars.Latex+import Document.Semantics.Html+import HRef.Semantics.Html+import Document.Semantics.NumberedHeaders+import Toc.Semantics.Toc+import Toc.Semantics.Html+import Document.Semantics.HtmlNumberedHeaders+import Toc.Semantics.Html+import Preprocessors++import Language.Grammars.Murder+import Language.Grammars.AspectAG+import Language.Grammars.Murder.UUParsing+import Language.Grammars.Grammar++ex = do contents <- readFile "examples/inputLatex"+        writeFile "examples/output.html" (latex2html'' contents)++-- | Builds a converter tool from an extensible grammar fragment and+--   a label of the synthesized output.+buildConverter :: (HasField l syn v)+               => (forall env . ExtGram env (Record HNil -> syn) nts) +               -> l +               -> String +               -> v+buildConverter gram att input = let parser = compile $ closeGram gram+                                    res    = result (parse parser input)+                                in  res emptyRecord # att++++-- Examples of different latex to html converters++latex2html   = buildConverter (gLatex semHtml) html++latex2html'  = buildConverter (gLatex semHtml') html++latex2html'' = buildConverter (gLatex semHtml'' +>> gLatexToc semHtmlToc) html+++++++test input = let parser = compile $ closeGram (gMarkdown undefined "#*=-")+             in  parse parser input++++html2html input = let  parser = compile $ closeGram (gHtml semHtml)+                       x      = result (parse parser input)+                   in  x emptyRecord # html+++-- example as+doc = Document [Header 1  [Plain "A document"],+                Paragraph [Plain "this is some ", Bold [Plain "really ", Italics [Plain "important"]], Plain " text."],+                Paragraph [Plain "mor text."]]
+ src/Toc/Decl.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE TemplateHaskell, EmptyDataDecls #-}+module Toc.Decl where++import Document.Decl++import Language.Grammars.AspectAG+import Language.Grammars.AspectAG.Derive++++data EXT_Block = Toc++$(extendAG ''EXT_Block [ ])+$(deriveLang "DocToc" [''EXT_Block])
+ src/Toc/Grammars/Latex.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE Arrows #-}++module Toc.Grammars.Latex where++import Language.Grammars.Grammar+import Language.Grammars.Murder++import Document.Grammars.Latex+import Document.Decl+import Toc.Decl++import Utils+++gLatexToc sem = proc imported -> do+    let block = getNT cs_block imported+    +    toc  <-addNT-<   iI (pToc sem) "\\tableofcontents" Ii+    addProds-< (block, iI toc Ii)+    +    exportNTs -< imported
+ src/Toc/Semantics/Html.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE TemplateHaskell, EmptyDataDecls, NoMonomorphismRestriction #-}+module Toc.Semantics.Html where++import Data.List+import Data.HList.Label4+import Data.HList.TypeEqGeneric1+import Data.HList.TypeCastGeneric1+import Language.Grammars.AspectAG+import Language.Grammars.AspectAG.Derive++import Document.Decl+import Toc.Decl+import Document.Semantics.Html+import Document.Semantics.NumberedHeaders+import Toc.Semantics.Toc+++-- | Rule that redefines the html attribute for headers such that the associated+--   header number is printed and its "id" value is set for navigation.+header_html' = syn html $ +    do level  <- at ch_level_header+       inls   <- at ch_inlines_header+       loc    <- at loc+       let num = loc # headerNum+       return $ "<h" ++ show level ++ " id=\"" ++ show num ++ "\">" +                 ++ formatNH num ++ " "+                 ++ inls # html+                 ++ "</h" ++ show level ++ ">"+                 ++ "\n"++-- | Rule that defines the html attribute for the table of contents+toc_html = syn html $+    do lhs <- at lhs+       return $ formatToc (lhs # toc)++-- | Formats the table of contents to html+formatToc :: [([Int], String)] -> String+formatToc = foldr f ""+    where f (x, section) table = "<a href=#" ++ show x ++ ">" +                               ++ (formatNH x) ++ " " ++ section +                               ++ "</a><br />\n" ++ table++++semHtml'' = mkDoc' (default_toc  `ext` blockLcons_html +                                 `ext` default_cHeaderNum    +                                 `ext` default_sToc)+                   (default_toc  `ext` blockLnil_html  +                                 `ext` default_cHeaderNum    +                                 `ext` default_sToc)+                   (bold_html    `ext` bold_sInlStr)+                   (document_toc `ext` document_cHeaderNum +                                 `ext` document_html)+                   (header_html'     `ext` header_cHeaderNum +                                     `ext` header_headerNum +                                     `ext` header_sToc)-- NOTE: this should be aspHeader instead+                   (inlineLcons_html `ext` default_sInlStr)+                   (inlineLnil_html  `ext` default_sInlStr)+                   (italics_html `ext` italics_sInlStr)+                   (default_toc `ext` paragraph_html   +                                `ext` default_cHeaderNum    +                                `ext` default_sToc)+                   (plain_html `ext` plain_sInlStr)+++semHtmlToc = mkDocToc (default_toc `ext` toc_html `ext` default_cHeaderNum    `ext` default_sToc)
+ src/Toc/Semantics/Toc.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE TemplateHaskell, EmptyDataDecls, NoMonomorphismRestriction #-}+module Toc.Semantics.Toc where++import Data.HList.Label4+import Data.HList.TypeEqGeneric1+import Data.HList.TypeCastGeneric1++import Language.Grammars.AspectAG+import Language.Grammars.AspectAG.Derive++import Document.Decl+import Document.Semantics.NumberedHeaders+++$(attLabels ["sToc", "toc", "sInlStr"])+++-- Inline string (ignores bold/italics formatting)++sInlStr_NTs = nt_InlineL .*. nt_Inline .*. HNil+++default_sInlStr = use sInlStr sInlStr_NTs (++) ""++plain_sInlStr = syn sInlStr $+                    do str <- at ch_str_plainInl+                       return $ str++bold_sInlStr = syn sInlStr $+                    do inl <- at ch_inlines_boldInl+                       return (inl # sInlStr)++italics_sInlStr = syn sInlStr $+                    do inl <- at ch_inlines_italInl+                       return (inl # sInlStr)+++++-- Synthesized TOC++sToc_NTs = nt_Block .*. nt_BlockL .*. HNil++default_sToc = use sToc sToc_NTs (++) []++header_sToc = syn sToc $+    do loc  <- at loc+       inls <- at ch_inlines_header+       return [(loc # headerNum, inls # sInlStr)]+++++-- Inherited TOC+++toc_NTs = nt_Block .*. nt_BlockL .*. HNil++document_toc = inh toc toc_NTs $+                do bls <- at ch_blocks+                   return $ (ch_blocks .=. bls # sToc) .*. emptyRecord++default_toc = copy toc toc_NTs 
+ src/Utils.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE Arrows, RecursiveDo, TemplateHaskell, EmptyDataDecls, NoMonomorphismRestriction, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, +             PostfixOperators, ScopedTypeVariables, DataKinds, KindSignatures, FunctionalDependencies, UndecidableInstances #-}+++module Utils where++import           Prelude hiding ((+), (*))+import           Control.Applicative+import           Control.Monad+import qualified GHC.TypeLits++import           Language.Grammars.Grammar+import           Language.Grammars.Murder+import           Language.Grammars.Murder.Derive+import           Language.Grammars.Murder.UUParsing+import           Language.Grammars.AspectAG+import qualified Text.ParserCombinators.UU.Core as UU++import Document.Decl++-- | Recognizes one or more characters except from the given list+someExcept :: [Char] -> PreProductions TL env String+someExcept cs = pSome $ iI value (sym $ anyExcept cs) Ii++-- | Recognizes zero or more characters except from the given list+manyExcept :: [Char] -> PreProductions TL env String+manyExcept cs = pMany $ iI value (sym $ anyExcept cs) Ii++-- | Recognizes one or more characters from the given list+someOf :: [Char] -> PreProductions TL env String+someOf cs = pSome $ iI value (sym $ anyOf cs) Ii++-- | Recognizes zero or more characters from the given list+manyOf :: [Char] -> PreProductions TL env String+manyOf cs = pMany $ iI value (sym $ anyOf cs) Ii+++-- | Recognizes alternating occurences of p1 and p2, starting with p1+alternate :: PreProductions l env a -> PreProductions l env a -> PreProductions l env [a]+alternate p1 p2 = (:) <$> p1 <*> (alternate p2 p1 <|> pure []) +++result :: ParseResult a -> a+result (Ok x) = x+result (Rep x _) = x++errors (Ok _) = []+errors (Rep _ es) = es+++parsePretty :: (Show a) => Parser a -> String -> IO a+parsePretty p input = +    do print $ "parsing: " ++ input+       let res = parse p input+       case res of+           (Ok a)         -> return a+           (Rep a errors) -> let errors' = map (shorten 60) errors+                             in  forM_ errors' putStrLn >> putStrLn "" >> return a++shorten x e | length (show e) > x = take (x-3) (show e) ++ "..."+            | otherwise           = show e+++-----+-- ? + * combinators+-----++{- +-- (*) x = pMany $ iI x Ii :: PreProductions l [a] env+-- (+) x = pSome $ iI x iI :: PreProductions l [a] env+-- (?) x = iI Just x Ii <|> pure Nothing :: PreProductions l (Maybe a) env+-}+++-- A transformation of a preproduction+newtype PreProductionsTrafo l env a b = PPT { unppt :: PreProductions l env a -> PreProductions l env b}++instance Idiomatic l env b g => Idiomatic l env a (PreProductionsTrafo l env a b -> g) where+    idiomatic prods f = idiomatic ((unppt f) prods)+++-- a, b: PreProductions is a wrapper for: PreProductions l env a -> PreProductions l env b+-- x : type for a symbol in the production +class Shortcuts l env a a' a'' b x| x -> l env a a' a'' b where+    (?) :: x -> PreProductionsTrafo l env a   b+    (+) :: x -> PreProductionsTrafo l env a'  b+    (*) :: x -> PreProductionsTrafo l env a'' b++instance Shortcuts TL env a a a a [Char] where+    (?) x = PPT (\prods -> prods <* pMaybe (Nothing, Just) (tr x))+    (+) x = PPT (\prods -> prods <* pMany (tr x))+    (*) x = PPT (\prods -> prods <* pSome (tr x))++instance Shortcuts TL env (Maybe a -> b) ([a] -> b) ([a] -> b) b (Symbol a t env) where+    (?) x = PPT (\prods -> prods <*> pMaybe (Nothing, Just) (sym x))+    (+) x = PPT (\prods -> prods <*> pSome (sym x))+    (*) x = PPT (\prods -> prods <*> pMany (sym x))++-- ignore the value of a symbol for the computation (idiomatic for <*)+data Ign a = Ign a+ign = Ign++{- Tried more general approach, not working++instance (Idiomatic l env f g, Idiomatic l env (a -> f) (x     -> g)) +                            => Idiomatic l env (a -> f) (Ign x -> g) where+    idiomatic pprods (Ign symb) = idiomatic (pprods <*> (iI symb Ii :: PreProductions l env a))++-}++-- ignore PreProductions+instance Idiomatic l env f g => Idiomatic l env f (Ign (PreProductions l env a) -> g) where+    idiomatic prods (Ign prods') = idiomatic (prods <* prods')++-- ignore Non terminals+instance Idiomatic l env f g => Idiomatic l env f (Ign (Symbol a TNonT env) -> g) where+    idiomatic prods (Ign s) = idiomatic (prods <* sym s)++instance Idiomatic l env f g => Idiomatic l env f (Ign String -> g) where+    idiomatic prods (Ign str) = idiomatic (prods <* tr str)+++++-- bit of error reporting+class Error (e :: GHC.TypeLits.Symbol)++instance Error ("Missing a closing Ii") => Idiomatic l env x (PreProductions l a env) where+    idiomatic = undefined+++++-- also ignore PreProductions l env () and Symbol () t env+-- instance  Idiomatic l env f g  => Idiomatic  l env f (PreProductions l env () -> g) where+--    idiomatic isf is = idiomatic (isf <* is)++-- instance  Idiomatic l env f g  => Idiomatic  l env f (Symbol () t env -> g) where+--    idiomatic isf is = idiomatic (isf <* (sym is))