hlatex (empty) → 0.1
raw patch · 21 files changed
+5069/−0 lines, 21 filesdep +basedep +base-unicode-symbolsdep +containerssetup-changed
Dependencies added: base, base-unicode-symbols, containers, derive, directory, filepath, frquotes, mtl, process, template-haskell, transformers, uniplate, utf8-string
Files
- LICENSE +30/−0
- Language/LaTeX.hs +124/−0
- Language/LaTeX/Builder.hs +1141/−0
- Language/LaTeX/Builder/Babel.hs +44/−0
- Language/LaTeX/Builder/Beamer.hs +433/−0
- Language/LaTeX/Builder/Color.hs +128/−0
- Language/LaTeX/Builder/Graphics.hs +176/−0
- Language/LaTeX/Builder/Internal.hs +355/−0
- Language/LaTeX/Builder/Math.hs +877/−0
- Language/LaTeX/Builder/MonoidUtils.hs +24/−0
- Language/LaTeX/Builder/QQ.hs +96/−0
- Language/LaTeX/Builder/Rotating.hs +10/−0
- Language/LaTeX/Checker.hs +20/−0
- Language/LaTeX/Length.hs +117/−0
- Language/LaTeX/Printer.hs +245/−0
- Language/LaTeX/Slicer.hs +46/−0
- Language/LaTeX/Types.hs +523/−0
- Language/LaTeX/Unicode.hs +183/−0
- Setup.lhs +3/−0
- doc/user_guide.hs +440/−0
- hlatex.cabal +54/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2009, Nicolas Pouillard+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of the copyright holders nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Language/LaTeX.hs view
@@ -0,0 +1,124 @@+module Language.LaTeX+ (+ -- * Types+ Document+ ,LineNumber+ ,CharNumber+ ,Loc+ ,Note+ ,Named+ ,DocumentClassKind+ ,DocumentClss+ ,Star+ ,Coord+ ,Percentage+ ,TexUnit+ ,LatexLength+ ,RowSpec+ ,LocSpec+ ,Pos+ ,LatexPaperSize+ ,Row+ ,PackageName+ ,Key+ ,SaveBin+ ,LatexState+ ,TexDecl+ ,LatexItem+ ,ParItem+ ,MathDecl+ ,AnyItem+ ,MathItem+ ,ListItem+ ,PreambleItem+ ,DocumentClass+ ,LatexM+ ,Encoding+ -- * Internal types+ ,Arg+ ,MathDcl+ ,AnyItm+ ,PreambleItm+ ,TexDcl+ ,LatexItm+ ,ParItm+ ,MathItm+ ,ListItm+ -- * Writer type aliases+ ,TexDeclW+ ,LatexItemW+ ,ParItemW+ ,MathDeclW+ ,MathItemW+ ,PreambleItemW+ -- * Utils+ ,module Language.LaTeX.Builder.MonoidUtils+ ,(!$), ($?), (!$?), tell, Writer+ ,(★)+ ,Monoid(..)+ ,printLatexDocument+ ,ViewOpts(..)+ ,quickView+ ,myViewOpts+ ,testViewOpts+ ,showLaTeX+ ,runLatexM+ )+where+import Data.Monoid (Monoid(..))+import Data.List (intercalate)+import Language.LaTeX.Types+import Language.LaTeX.Printer (showLaTeX)+import Language.LaTeX.Builder.MonoidUtils+import Language.LaTeX.Builder ((!$), ($?), (!$?), (★))+import Control.Monad (when)+import Control.Monad.Writer (Writer, tell)+import System.Cmd (system)+import System.FilePath+import System.Directory (createDirectoryIfMissing)+import System.Exit+import qualified System.IO.UTF8 as U+-- import Codec.Binary.UTF8.String (encodeString)++data ViewOpts = ViewOpts { basedir :: FilePath+ , pdflatex :: String+ , pdfviewer :: String+ , inputdirs :: [FilePath]+ , showoutput :: Bool }++myViewOpts, testViewOpts :: ViewOpts+myViewOpts = ViewOpts { basedir = ""+ , pdflatex = "texi2pdf"+ , pdfviewer = "open"+ , inputdirs = []+ , showoutput = True }++testViewOpts = myViewOpts { basedir = "tests" }++{-+-- | The computation 'writeBinaryFile' @file str@ function writes the string @str@,+-- to the file @file@.+writeBinaryFile :: FilePath -> String -> IO ()+writeBinaryFile f txt = withBinaryFile f WriteMode (\ hdl -> hPutStr hdl txt)+-}++quickView :: ViewOpts -> FilePath -> LatexM Document -> IO ()+quickView vo basename doc =+ do createDirectoryIfMissing False (basedir vo)+ when (showoutput vo) $ putStrLn s+ -- writeBinaryFile (basedir vo </> tex) s+ U.writeFile (basedir vo </> tex) s+ exitWith =<< system cmd+ -- where s = encodeString . either error id $ showLaTeX doc+ where s = either error id $ showLaTeX doc+ pdf = basename <.> "pdf"+ tex = basename <.> "tex"+ inputdirsStr = intercalate ":" $ inputdirs vo+ texinputs = "TEXINPUTS=" ++ inputdirsStr+ bstinputs = "BSTINPUTS=" ++ inputdirsStr+ cmd = unwords ["cd", basedir vo, "&&"+ , texinputs, bstinputs, pdflatex vo, tex, "&&"+ , pdfviewer vo, pdf]++printLatexDocument :: LatexM Document -> IO ()+printLatexDocument = putStr . either error id . showLaTeX
+ Language/LaTeX/Builder.hs view
@@ -0,0 +1,1141 @@+module Language.LaTeX.Builder+ ( (!$), (!$?), ($?), HaveC(..), HaveL(..), HaveR(..),+Spaces(..),+-- * Injecting declarations+decl, decls, parDecls, parDecl,+-- * Others+_AA, _AE, _H, _Huge, _L, _LARGE, _LaTeX,+_Large, _O, _OE, _P, _S, _TeX, _l, XChar, a4paper, aa,+acute, addvspace, ae, allTexDecls, appendix,+article, author, authors,+bf, bfseries, bigskip,+bibliography, bibliographystyle, book, boxedminipage,+caption, caption', cedil, cell, cells, center, chapter, chapter',+check, circ, cite, cite', cleardoublepage, clearpage, cline,+comment, compressSpaces, copyright, corrspace, dag, dash1,+dash2, dash3, date, ddag,+description, displaymath,+document, documentclass, dot, dotfill, dquote, em, emph, enumerate,+fbox, figure, flushleft, footnote,+footnotesize, framebox, fussy, grave, group, hat, hchar,+hfill, hline, hr, href, hrulefill, space, hspace, hspace', hspaces,+hstring, huge, hyphen, hyphenation, hyphenationPar, i, institute, it, item,+item', itemize, itshape, j, label,+large, ldots, letter, linebreak, linebr,+lq, ldq, makebox, maketitle,+math, mbox, mdseries, medskip,+minipage, nbsp, negthinspace, newline, rawNewline,+newpage, nocite, noindent, nolinebreak, nopagebreak, normalfont,+normalmarginpar, normalsize, num, o, oe, overbar, overdot, pagebreak,+pageref, pagestyle, para, paragraph, paragraph', parbox, part, part', person, phantom, pounds,+protect, protector, quotation, quote, raisebox, raisebox',+rat, ref, report, reversemarginpar, ring, rm, rmfamily, rq, rdq,+rtext, rule, rule', samepage, savebox, sbox, sc, scriptsize, scshape, section,+section', sep, setlength, addtolength, settowidth, sf, sffamily, sl, sloppy, sloppypar,+slshape, small, smallskip, spaceProtector, ss, subparagraph,+subparagraph', subsection, subsection',+subsubsection, subsubsection', subtitle, table,+tableofcontents, tabular, textbf, textdegree,+textit, textmd, textnormal, textrm, textsc, textsf,+textsl, texttt, textup, textsuperscript, textsubscript, textunderscore,+thinspace, thispagestyle, tieafter, tilde,+tiny, title, titlepage, tt, ttchar, ttfamily, uml,+underbar, unwords, upshape, usebox, verb, verse, vfill, vline,+vphantom, vspace, vspace', (★), vbox, vtop, hbox, here, top, bot, bottom, page, normal,+centered, flushLeft, flushRight, stretch,+-- * Input Encodings (inputenc package)+utf8,latin1,inputenc,fromEncoding,+ )+ where++++import Prelude hiding (sqrt, min, max, lcm, gcd, log, mod, tanh, cosh, tan, sinh,+ sin, cos, succ, sum, pi, mapM, unwords)+import Data.List hiding (sum, and, group, unwords)+import qualified Data.List as L+import Data.Ratio+import Data.Monoid+import Data.Char+import Data.Maybe+import Data.Foldable (foldMap)+import Data.Traversable+import Data.String (IsString(..))+import Control.Applicative hiding (optional)+import Control.Monad hiding (mapM)+import Control.Monad.Error (throwError)+import Control.Monad.Writer (Writer, execWriter, tell)+import Control.Arrow++import Language.LaTeX.Types+import Language.LaTeX.Builder.Internal+import qualified Language.LaTeX.Length as L+import Language.LaTeX.Builder.MonoidUtils+++{-+import Prelude (writeFile, id, Monad(..), fst)+import Language.Haskell.TH+-}+++-- references: http://dmr.ath.cx/notes/tex.html++(★) :: Star+(★) = Star++group :: LatexItem -> LatexItem+group = liftM TexGroup++infixr 0 !$+infixr 0 $?+infixr 0 !$?++(!$) :: Monoid b => (a -> b) -> a -> Writer b ()+(!$) f x = tell $ f x++($?) :: (a -> b) -> Writer a () -> b+($?) f m = f $ execWriter m++-- NOTE: This combinator seems pretty promising...+(!$?) :: Monoid b => (a -> b) -> Writer a () -> Writer b ()+(!$?) f m = tell $ f $ execWriter m++math :: MathItem -> LatexItem+math = latexCast . mathItem++displaymath :: MathItem -> ParItem+displaymath = parCast . mathItem++decls :: [TexDecl] -> LatexItem -> LatexItem+decls ds x = group (rawDecls ds ⊕ x)++decl :: TexDecl -> LatexItem -> LatexItem+decl = decls . pure++parDecls :: [TexDecl] -> ParItem+parDecls = para . rawDecls++parDecl :: TexDecl -> ParItem+parDecl = parDecls . pure++document :: DocumentClass -> PreambleItem -> ParItem -> LatexM Document+document = liftM3 Document++dash1, dash2, dash3, nbsp :: LatexItem+dash1 = rawTex "{-}"+dash2 = rawTex "{--}"+dash3 = rawTex "{---}"++nbsp = rawTex "{~}"+-- Do we want to treat '\160' as an nbsp too?++-- | 'sep' is like '{}' in LaTeX, it allows to force letters to be treaten separately,+-- for instance to separate the two 'f's in shelfful.+sep :: LatexItem+sep = group ø++{- GHC bug with OverloadedStrings+f "" = 1+f ('a':_) = 2+f _ = 3+-}++newtype Spaces = Spaces { countSpaces :: Int }++hspaces :: Spaces -> LatexItem+hspaces = mbox . hspace . L.em . (1%2 *) . fromIntegral . countSpaces++compressSpaces :: String -> [Either Char Spaces]+compressSpaces [] = []+compressSpaces (' ':xs)+ = uncurry (:) . (Right . Spaces . (+1) . length *** compressSpaces) . span (==' ') $ xs+compressSpaces (x:xs) = Left x : compressSpaces xs++type XChar = Char -> LatexItem++spaceProtector :: XChar -> String -> LatexItem+spaceProtector xchar = foldMap (either xchar hspaces) . compressSpaces++protector :: XChar -> String -> LatexItem+protector = spaceProtector . nlchar++protect :: String -> LatexItem+protect = protector hchar++-- Turns @'\n'@ into 'newline' and others with the given translator.+nlchar :: XChar -> XChar+nlchar _ '\n' = rawNewline ø+nlchar xchar ch = xchar ch++hchar :: XChar+hchar = rawTex . rawhchar++ttchar :: XChar+ttchar ch | isAscii ch &&+ isPrint ch &&+ not (isAlphaNum ch) = rawTex $ "{\\char `\\" ++ ch : "}"+ | isAscii ch &&+ not (isPrint ch) = verb . show $ ch+ | otherwise = rawTex [ch]++verb :: String -> LatexItem+verb = texttt . protector ttchar++-- A comment put in the generated LaTeX document+comment :: String -> LatexItem+comment s = latexNote (MkKey "comment") (stringNote s) ø++href :: LatexItem -> LatexItem -> LatexItem+href x y = latexCmdArgs "href" [mandatory x,mandatory y]++person :: String -> String -> LatexItem+person name email = href (hstring ("mailto:"++email)) (hstring name)++-- simulate the <hr> html tag+hr :: LatexItem+hr = group $ noindent ⊕ rule L.linewidth (L.pt 1.5)++hstring :: String -> LatexItem+hstring = fromString+++tableofcontents :: ParItem+tableofcontents = parCmdArgs "tableofcontents" []++maketitle :: ParItem+maketitle = parCmdArgs "maketitle" []++-- par = texCmdNoArg "par"+noindent :: LatexItem+noindent = texCmdNoArg "noindent"++-- Marginal Notes++reversemarginpar :: TexDecl+reversemarginpar = texDecl "reversemarginpar"+normalmarginpar :: TexDecl+normalmarginpar = texDecl "normalmarginpar"++-- The tabbing Environment++-- TODO++-- Spaces++-- robust+-- http://www.personal.ceu.hu/tex/spacebox.htm#hspace+hspace' :: Star -> LatexLength -> LatexItem+hspace' s = latexCmdAnyArg (starize "hspace" s) . texLength++-- robust+-- http://www.personal.ceu.hu/tex/spacebox.htm#hspace+hspace :: LatexLength -> LatexItem+hspace = hspace' ø++-- fragile+-- they says that's a command however putting braces around disable+-- its effect. We expose it as a ParItem since this is its main usage.+-- http://www.personal.ceu.hu/tex/spacebox.htm#vspace+vspace' :: Star -> LatexLength -> ParItem+vspace' s = parCmdArg (starize "vspace" s) . texLength++-- fragile+-- http://www.personal.ceu.hu/tex/spacebox.htm#vspace+vspace :: LatexLength -> ParItem+vspace = vspace' ø++-- http://www.personal.ceu.hu/tex/spacebox.htm#vfill+vfill :: ParItem+vfill = parCmdArgs "vfill" [] -- = vspace fill++-- http://www.personal.ceu.hu/tex/spacebox.htm#hfill+hfill :: LatexItem+hfill = texCmdNoArg "hfill" -- = hspace fill++dotfill :: LatexItem+dotfill = texCmdNoArg "dotfill"++hrulefill :: LatexItem+hrulefill = texCmdNoArg "hrulefill"++thinspace :: LatexItem+thinspace = texCmdNoArg "thinspace"++negthinspace :: LatexItem+negthinspace = texCmdNoArg "!"++-- The italic correction space (\/ in LaTeX)+corrspace :: LatexItem+corrspace = texCmdNoArg "/"++-- fragile+-- http://www.personal.ceu.hu/tex/spacebox.htm#bskip+bigskip :: ParItem+bigskip = parCmdArgs "bigskip" [] -- = vspace bigskipamount++-- fragile+-- http://www.personal.ceu.hu/tex/spacebox.htm#bskip+medskip :: ParItem+medskip = parCmdArgs "medskip" [] -- = vspace medskipamount++-- fragile+-- http://www.personal.ceu.hu/tex/spacebox.htm#bskip+smallskip :: ParItem+smallskip = parCmdArgs "smallskip" [] -- = vspace smallskipamount++-- http://www.personal.ceu.hu/tex/spacebox.htm#addvspace+addvspace :: LatexLength -> ParItem+addvspace = parCmdArg "addvspace" . texLength++unwords :: [LatexItem] -> LatexItem+unwords = mconcat . intersperse space++-- TODO+-- unlines:+-- * does it makes sense?+-- * given that newline can be forbidden at some places is it safe?+-- * Why not just a minipage ? . mconcat++-- Fonts+-- some ref used: http://www.cl.cam.ac.uk/~rf10/pstex/latexcommands.htm++-- Font sizes++-- those could be seen as taking an argument+tiny, scriptsize, footnotesize, small, normalsize, large,+ _LARGE, _Large, huge, _Huge, mdseries, bfseries,+ itshape, slshape, scshape, upshape,+ rmfamily, sffamily, ttfamily, normalfont :: TexDecl+tiny = texDecl "tiny"+scriptsize = texDecl "scriptsize"+footnotesize = texDecl "footnotesize"+small = texDecl "small"+normalsize = texDecl "normalsize"+large = texDecl "large"+_LARGE = texDecl "LARGE"+_Large = texDecl "Large"+huge = texDecl "huge"+_Huge = texDecl "Huge"++bfseries = texDecl "bfseries"+mdseries = texDecl "mdseries"+rmfamily = texDecl "rmfamily"+sffamily = texDecl "sffamily"+ttfamily = texDecl "ttfamily"+upshape = texDecl "upshape"+itshape = texDecl "itshape"+slshape = texDecl "slshape"+scshape = texDecl "scshape"+normalfont = texDecl "normalfont"++emph, textrm, textsf, texttt, textmd, textbf,+ textup, textit, textsl, textsc, textnormal,+ textsuperscript, textsubscript :: LatexItem -> LatexItem+-- textXYZ commands should work in math too (use a typeclass)+emph = latexCmdArg "emph"+textrm = latexCmdArg "textrm"+textsf = latexCmdArg "textsf"+texttt = latexCmdArg "texttt"+textmd = latexCmdArg "textmd"+textbf = latexCmdArg "textbf"+textup = latexCmdArg "textup"+textit = latexCmdArg "textit"+textsl = latexCmdArg "textsl"+textsc = latexCmdArg "textsc"+textnormal = latexCmdArg "textnormal"++-- http://en.wikibooks.org/wiki/LaTeX/Formatting#Text_mode_superscript_and_subscript+textsuperscript = latexCmdArg "textsuperscript"++-- http://en.wikibooks.org/wiki/LaTeX/Formatting#Text_mode_superscript_and_subscript+-- fixltxe2 is not the only package providing textsubscript+textsubscript x = latexCmdArgs "textsubscript" [packageDependency (pkgName "fixltxe2")+ ,mandatory x]++-- Litteral underscore in text mode+textunderscore :: LatexItem+textunderscore = texCmdNoArg "textunderscore"++-- Line and page breaking++-- fragile+-- http://www.personal.ceu.hu/tex/breaking.htm#linebreak+linebreak :: Maybe Int -> TexDecl+linebreak = (texDecl' "linebreak" =<<) . check0to4 "linebreak"++-- fragile+-- http://www.personal.ceu.hu/tex/breaking.htm#nolinebreak+nolinebreak :: Maybe Int -> TexDecl+nolinebreak = (texDecl' "nolinebreak" =<<) . check0to4 "nolinebreak"++-- http://www.personal.ceu.hu/tex/breaking.htm#linebr+linebr :: Star -> Maybe LatexLength -> LatexItem+linebr s extraSpace =+ latexCmdAnyArgs "\\" [starToArg s+ ,maybe noArg optTexLength extraSpace+ ,rawArg "%\n"]++-- fragile+-- http://www.personal.ceu.hu/tex/breaking.htm#newline+rawNewline :: Maybe LatexLength -> LatexItem+rawNewline mlen =+ latexCmdAnyArgs "newline" [maybe noArg optTexLength mlen+ ,rawArg "%\n"]++-- fragile+-- http://www.personal.ceu.hu/tex/breaking.htm#newline+-- see rawNewline for a more permissive dangerous version of newline+newline :: Maybe LatexLength -> ParItem+newline = para . rawNewline++-- robust+-- http://www.personal.ceu.hu/tex/breaking.htm#hyph+hyphen :: LatexItem+hyphen = rawTex "{\\-}" -- TODO: check if {...} does not cause trouble here+ -- otherwise this may be considered a legit+ -- ``concatenation effect''.++-- robust+-- http://www.personal.ceu.hu/tex/breaking.htm#hyphw+hyphenation :: [String] -> PreambleItem+hyphenation = preambleCmdArg "hyphenation" . rawAnyTex . L.unwords -- rawAnyTex is a bit rough here++hyphenationPar :: [String] -> ParItem+hyphenationPar = parCmdArg "hyphenation" . rawAnyTex . L.unwords -- rawAnyTex is a bit rough here++sloppy, fussy :: TexDecl+sloppy = texDecl "sloppy"+fussy = texDecl "fussy"+++sloppypar :: ParItem -> ParItem+sloppypar = parEnvironmentPar "sloppypar" []++-- fragile+-- http://www.personal.ceu.hu/tex/breaking.htm#pagebreak+pagebreak :: Maybe Int -> TexDecl+pagebreak = (texDecl' "pagebreak" =<<) . check0to4 "pagebreak"++-- fragile+-- http://www.personal.ceu.hu/tex/breaking.htm#nopagebreak+nopagebreak :: Maybe Int -> TexDecl+nopagebreak = (texDecl' "nopagebreak" =<<) . check0to4 "nopagebreak"++-- fragile+samepage :: TexDecl+samepage = texDecl "samepage"++-- robust+-- http://www.personal.ceu.hu/tex/breaking.htm#newpage+newpage :: ParItem+newpage = parCmdArgs "newpage" []++-- robust+-- http://www.personal.ceu.hu/tex/breaking.htm#clrpage+clearpage :: ParItem+clearpage = parCmdArgs "clearpage" []++-- fragile+-- http://www.personal.ceu.hu/tex/breaking.htm#clrdblpage+cleardoublepage :: ParItem+cleardoublepage = parCmdArgs "cleardoublepage" []++--- Boxes++-- TeX level+-- http://dmr.ath.cx/notes/tex.html#entry25+hbox :: LatexItem -> LatexItem+hbox = latexCmdArg "hbox"++-- TeX level+-- http://dmr.ath.cx/notes/tex.html#entry25+vbox :: ParItem -> LatexItem+vbox = latexParModeArgs "vbox" []++-- TeX level+-- http://dmr.ath.cx/notes/tex.html#entry25+vtop :: ParItem -> LatexItem+vtop = latexParModeArgs "vtop" []++-- TODO+-- vbox_to :: LatexLength -> ParItem -> LatexItem+-- vbox_to width = latexParModeArgs "vbox" [to $ texLength width]++{-+class Mbox a where+ -- robust+ mbox :: LatexItem -> a++ -- fragile+ makebox :: LatexLength -> LatexLength -> LatexItem -> a++instance Mbox MathItem where+ mbox = MathToLR Nothing Nothing+ makebox = mmakebox++instance Mbox LatexItem where+ mbox = id++instance Mbox ParItem where+-}++-- robust+-- http://www.personal.ceu.hu/tex/spacebox.htm#makebox+mbox :: LatexItem -> LatexItem+mbox = latexCmdArg "mbox"++posArg :: Pos -> Arg AnyItem+posArg = optional . rawAnyTex . pure . charPos++-- fragile+-- http://www.personal.ceu.hu/tex/spacebox.htm#makebox+makebox :: LatexLength -> Pos -> LatexItem -> LatexItem+makebox width pos txt =+ latexCmdAnyArgs "makebox" [optTexLength width+ ,posArg pos+ ,mandatoryLatexItem txt]++-- robust+fbox :: LatexItem -> LatexItem+fbox = latexCmdArg "fbox"++-- fragile+-- http://www.personal.ceu.hu/tex/spacebox.htm#framebox+framebox :: LatexLength -> Pos -> LatexItem -> LatexItem+framebox width pos txt = latexCmdAnyArgs "framebox" [optTexLength width+ ,posArg pos+ ,mandatoryLatexItem txt]++phantom :: LatexItem -> LatexItem+phantom = latexCmdArg "phantom"++vphantom :: LatexItem -> LatexItem+vphantom = latexCmdArg "vphantom"++-- robust+sbox :: SaveBin -> LatexItem -> LatexItem+sbox bin txt = latexCmdAnyArgs "sbox" [mandatory $ latexSaveBin bin, mandatoryLatexItem txt]++-- fragile+savebox :: SaveBin -> Maybe LatexLength -> Maybe (Either () ()) -> LatexItem -> LatexItem+savebox bin width dir txt =+ latexCmdAnyArgs "savebox" [mandatory $ latexSaveBin bin+ ,maybe noArg optTexLength width+ ,maybe noArg (optionalLatexItem . either ll rr) dir+ ,mandatoryLatexItem txt]+ where ll _ = rawTex "l"+ rr _ = rawTex "r"++-- robust+usebox :: SaveBin -> LatexItem+usebox bin = latexCmdAnyArgs "usebox" [mandatory $ latexSaveBin bin]++-- vertical position for parbox and minipage+data VPos = Normal+ | Top+ | Bot++vposArg :: VPos -> Arg AnyItem+vposArg Normal = noArg+vposArg Top = optional . rawAnyTex $ "t"+vposArg Bot = optional . rawAnyTex $ "b"++-- fragile+-- http://www.personal.ceu.hu/tex/spacebox.htm#parbox+parbox :: VPos -> LatexLength -> LatexItem -> LatexItem+parbox pos width txt =+ latexCmdAnyArgs "parbox" [vposArg pos, mandatory $ texLength width, mandatoryLatexItem txt]++minipage :: VPos -> LatexLength -> ParItem -> LatexItem+minipage pos width = latexEnvironmentPar "minipage" [vposArg pos, mandatory $ texLength width]++-- fragile+-- http://www.personal.ceu.hu/tex/spacebox.htm#rule+rule :: LatexLength -> LatexLength -> LatexItem+rule width height = latexCmdAnyArgs "rule" [mandatory $ texLength width+ ,mandatory $ texLength height]++-- fragile+rule' :: LatexLength -> LatexLength -> LatexLength -> LatexItem+rule' raise_len width height = latexCmdAnyArgs "rule" [optTexLength raise_len+ ,mandatory $ texLength width+ ,mandatory $ texLength height]++-- fragile+-- http://www.personal.ceu.hu/tex/spacebox.htm#raisebox+raisebox :: LatexLength -> LatexItem -> LatexItem+raisebox raise_len txt =+ latexCmdAnyArgs "raisebox" [mandatory $ texLength raise_len+ ,mandatoryLatexItem txt]++-- fragile+raisebox' :: LatexLength -> LatexLength -> LatexLength -> LatexItem -> LatexItem+raisebox' raise_len height depth txt =+ latexCmdAnyArgs "raisebox" [mandatory $ texLength raise_len+ ,optTexLength height+ ,optTexLength depth+ ,mandatoryLatexItem txt]++footnote :: LatexItem -> LatexItem+footnote = latexCmdArg "footnote"++caption :: LatexItem -> LatexItem+caption txt = latexCmdArgs "caption" [mandatory txt]+caption' :: String -> LatexItem -> LatexItem+caption' lstentry txt = latexCmdArgs "caption" [optional $ checkentry lstentry, mandatory txt]+ where checkentry x+ | all isAlphaNum x = rawTex x+ | otherwise = throwError "caption': restriction to alphanumeric characters for the lstentry"++label :: Key -> LatexItem+label = latexCmdAnyArg "label" . latexKey+ref :: Key -> LatexItem+ref = latexCmdAnyArg "ref" . latexKey+pageref :: Key -> LatexItem+pageref = latexCmdAnyArg "pageref" . latexKey++-- fragile+cite :: [Key] -> LatexItem+cite = latexCmdAnyArgs "cite" . pure . latexKeysArg+cite' :: LatexItem -> [Key] -> LatexItem+cite' txt keys = latexCmdAnyArgs "cite" [optionalLatexItem txt, latexKeysArg keys]++-- fragile+nocite :: [Key] -> LatexItem+nocite = latexCmdAnyArgs "nocite" . pure . latexKeysArg++-- sectioning++part, chapter, section, subsection, subsubsection, paragraph,+ subparagraph :: LatexItem -> ParItem+part', chapter', section', subsection', subsubsection', paragraph',+ subparagraph' :: Star -> Maybe LatexItem -> LatexItem -> ParItem++(part, part') = sectioning "part"+(chapter, chapter') = sectioning "chapter"+(section, section') = sectioning "section"+(subsection, subsection') = sectioning "subsection"+(subsubsection, subsubsection') = sectioning "subsubsection"+(paragraph, paragraph') = sectioning "paragraph"+(subparagraph , subparagraph') = sectioning "subparagraph"++-- | Don't confuse 'paragraph' with 'para', 'para' is to make a paragraph,+-- 'paragraph' is to name a set of paragraphs.+para :: LatexItem -> ParItem+para = parCast . latexItem++bibliography :: LatexItem -> ParItem+bibliography = parCmdArg "bibliography" . latexItem+bibliographystyle :: LatexItem -> ParItem+bibliographystyle = parCmdArg "bibliographystyle" . latexItem+thispagestyle :: LatexItem -> ParItem+thispagestyle = parCmdArg "thispagestyle" . latexItem+pagestyle :: LatexItem -> ParItem+pagestyle = parCmdArg "pagestyle" . latexItem++appendix :: ParItem+appendix = parCmdArgs "appendix" []++-- http://www.personal.ceu.hu/tex/length.htm+setlength :: LatexLength -> LatexLength -> ParItem+setlength lengthName newLength+ | isJust (lengthCst lengthName)+ = throwError "setlength: the first argument should be a length name not a constant"+ | otherwise+ = parCmdArgs "setlength" [mandatory (texLength lengthName)+ ,mandatory (texLength newLength)]++-- http://www.personal.ceu.hu/tex/length.htm+addtolength :: LatexLength -> LatexLength -> ParItem+addtolength lengthName newLength+ | isJust (lengthCst lengthName)+ = throwError "addtolength: the first argument should be a length name not a constant"+ | otherwise+ = parCmdArgs "addtolength" [mandatory (texLength lengthName)+ ,mandatory (texLength newLength)]++-- http://www.personal.ceu.hu/tex/length.htm+settowidth :: LatexLength -> LatexItem -> ParItem+settowidth lengthName text+ | isJust (lengthCst lengthName)+ = throwError "settowidth: the first argument should be a length name not a constant"+ | otherwise+ = parCmdArgs "settowidth" [mandatory (texLength lengthName)+ ,mandatoryLatexItem text]++item :: ParItem -> ListItem+item = liftM $ ListItm []++item' :: LatexItem -> ParItem -> ListItem+item' a = liftM2 ListItm (pure . optional <$> a)++itemize :: Maybe LatexItem -> [ListItem] -> ParItem+itemize = listLikeEnv "itemize" . pure . maybe noArg optional++-- enumerate counters are enumi, enumii, enumiii, enumiv+enumerate :: Maybe LatexItem -> [ListItem] -> ParItem+enumerate = listLikeEnv "enumerate" . pure . maybe noArg optional++description :: Maybe LatexItem -> [ListItem] -> ParItem+description = listLikeEnv "description" . pure . maybe noArg optional++figure, table :: Star -> [LocSpec] -> ParItem -> ParItem+figure = figureLike "figure"+table = figureLike "table"++-- Accents++-- | Add a cedila to a letter (\c{...} in LaTeX)+cedil :: LatexItem -> LatexItem+cedil = latexCmdArg "c"++grave :: LatexItem -> LatexItem+grave = latexCmdArg "`"++acute :: LatexItem -> LatexItem+acute = latexCmdArg "'"++uml :: LatexItem -> LatexItem+uml = latexCmdArg "\""++circ :: LatexItem -> LatexItem+circ = latexCmdArg "^"++-- alias of 'circ'+hat :: LatexItem -> LatexItem+hat = latexCmdArg "^"++check :: LatexItem -> LatexItem+check = latexCmdArg "v"++i :: LatexItem+i = texCmdNoArg "i"++j :: LatexItem+j = texCmdNoArg "j"++tilde :: LatexItem -> LatexItem+tilde = latexCmdArg "~"++dot :: LatexItem -> LatexItem+dot = latexCmdArg "d"++ring :: LatexItem -> LatexItem+ring = latexCmdArg "r"++-- TODO find a name+_H :: LatexItem -> LatexItem+_H = latexCmdArg "H"++-- Produces a dot accent over the following (\.{x} in LaTeX)+overdot :: LatexItem -> LatexItem+overdot = latexCmdArg "."++-- Produces a macron (overbar) accent over the following+overbar :: LatexItem -> LatexItem+overbar = latexCmdArg "="++-- Produces a macron (overbar) accent over the following+underbar :: LatexItem -> LatexItem+underbar = latexCmdArg "b"++-- Produces a tie-after accent, as in `oo[' (\t in LaTeX).+tieafter :: LatexItem -> LatexItem+tieafter = latexCmdArg "t"++-- Some non-English characters++-- The 'å' letter (like @ring "a"@)+aa :: LatexItem+aa = texCmdNoArg "aa"++-- The 'Å' letter (like @ring "A"@)+_AA :: LatexItem+_AA = texCmdNoArg "AA"++-- The 'æ' letter+ae :: LatexItem+ae = texCmdNoArg "ae"++-- The 'Æ' letter+_AE :: LatexItem+_AE = texCmdNoArg "AE"++-- The 'œ' letter+oe :: LatexItem+oe = texCmdNoArg "oe"++-- The 'Œ' letter+_OE :: LatexItem+_OE = texCmdNoArg "OE"++-- The 'ß' letter+ss :: LatexItem+ss = texCmdNoArg "ss"++-- The '/l' letter+_l :: LatexItem+_l = texCmdNoArg "l"++-- The '/L' letter+_L :: LatexItem+_L = texCmdNoArg "L"++-- The 'ø' letter+o :: LatexItem+o = texCmdNoArg "o"++-- The 'Ø' letter+_O :: LatexItem+_O = texCmdNoArg "O"++-- Text symbols++-- | The copyright symbol, ©.+copyright :: LatexItem+copyright = texCmdNoArg "copyright"++-- | The dagger symbol (in text).+dag :: LatexItem+dag = texCmdNoArg "dag"++-- | The double dagger symbol (in text).+ddag :: LatexItem+ddag = texCmdNoArg "ddag"++-- | The LaTeX logo.+_LaTeX :: LatexItem+_LaTeX = texCmdNoArg "LaTeX"++-- | The TeX logo.+_TeX :: LatexItem+_TeX = texCmdNoArg "TeX"++-- | An ellipsis (three dots at the baseline): `...'. This command also works in math mode.+ldots :: LatexItem+ldots = texCmdNoArg "ldots"++-- | Left (opening) quote: `.+lq :: LatexItem+lq = texCmdNoArg "lq"++-- | Right (closing) quote: '.+rq :: LatexItem+rq = texCmdNoArg "rq"++-- | Left (opening) double quotes: ``.+ldq :: LatexItem+ldq = rawTex "{``}"++-- | Right (opening) double quotes: ''.+rdq :: LatexItem+rdq = rawTex "{''}"++-- | Double quote a LaTeX item.+dquote :: LatexItem -> LatexItem+dquote x = ldq ⊕ x ⊕ rdq++-- | Paragraph sign (pilcrow).+_P :: LatexItem+_P = texCmdNoArg "P"++-- | English pounds sterling.+pounds :: LatexItem+pounds = texCmdNoArg "pounds"++-- | Section symbol.+_S :: LatexItem+_S = texCmdNoArg "S"++textdegree :: LatexItem+textdegree = latexCmdArgs "textdegree" [packageDependency (pkgName "textcomp"), mandatory ø]++-- check options+titlepage, flushleft, center, boxedminipage, quotation, verse :: ParItem -> ParItem+titlepage = parEnvironmentPar "titlepage" []+flushleft = parEnvironmentPar "flushleft" []+center = parEnvironmentPar "center" []+boxedminipage = parEnvironmentPar "boxedminipage" []+quotation = parEnvironmentPar "quotation" []+verse = parEnvironmentPar "verse" []++quote :: LatexItem -> ParItem+quote = liftM $ ParEnv "quote" [] . LatexItm++-- The array and tablular Environments++tabular :: [RowSpec LatexItem] -> [Row LatexItem] -> ParItem+tabular = tabularLike Tabular++cells :: [a] -> Row a+cells = Cells++cell :: a -> Row a+cell = Cells . pure++hline :: Row a+hline = Hline+cline :: Int -> Int -> Row a+cline = Cline++-- this is more the '|' than the \vline of LaTeX,+-- one may want to support both using a HaveVline type class.+vline :: RowSpec a+vline = Rvline++rtext :: a -> RowSpec a+rtext = Rtext++class HaveC a where c :: a+class HaveL a where l :: a+class HaveR a where r :: a++instance HaveC (RowSpec a) where c = Rc+instance HaveL (RowSpec a) where l = Rl+instance HaveR (RowSpec a) where r = Rr++class HaveTop a where top :: a+instance HaveTop LocSpec where top = Lt+instance HaveTop VPos where top = Top++class HaveBot a where bot :: a+instance HaveBot LocSpec where bot = Lb+instance HaveBot VPos where bot = Bot++class HaveNormal a where normal :: a+instance HaveNormal VPos where normal = Normal++bottom :: HaveBot a => a+bottom = bot++here, page :: LocSpec+here = Lh+page = Lp++centered, flushLeft, flushRight, stretch :: Pos+centered = Centered+flushLeft = FlushLeft+flushRight = FlushRight+stretch = Stretch+++-- eqnarraystar = ++a4paper :: LatexPaperSize+a4paper = A4paper++documentclass :: DocumentClassKind -> [AnyItem] ->+ DocumentClass+documentclass dc = (DocClass dc <$>) . mapM anyItmM++article :: Maybe LatexLength -> Maybe LatexPaperSize ->+ [AnyItem] -> DocumentClass+article msize mpaper args =+ documentclass Article $ maybeToList (latexPaper <$> mpaper) +++ maybeToList (texLength <$> msize) +++ args++-- TODO improve options+letter :: [AnyItem] -> DocumentClass+letter = documentclass Letter++book :: Maybe LatexLength -> Maybe LatexPaperSize ->+ [AnyItem] -> DocumentClass+book msize mpaper args =+ documentclass Book $ maybeToList (latexPaper <$> mpaper) +++ maybeToList (texLength <$> msize) +++ args++-- TODO improve options+report :: [AnyItem] -> DocumentClass+report = documentclass Report++{-+$(+ let+ mathCmdsArg, allTexDecls, mathDecls :: [String]+ mathCmds :: [(String, String)]++ mathCmds =+ [("lbrace", "{")+ ,("rbrace", "}")+ ,("space", " ")+ ,("at", "@")+ ,("in_", "in")+ ,("forall_", "forall")+ ,("thinspace", ",")+ ,("negthinspace", "!")+ ,("mediumspace", ":")+ ,("thickspace", ";")+ ,("msup", "sup")+ ] ++ map (id &&& id)+ [-- Greek letters+ "alpha","beta","chi","delta","Delta","epsilon","varepsilon","eta","gamma"+ ,"Gamma","iota","kappa","lambda","Lambda","mu","nu","omega","Omega","phi"+ ,"varphi","Phi","pi","Pi","psi","rho","sigma","Sigma","tau","theta"+ ,"vartheta","Theta","upsilon","xi","Xi","zeta"++ -- Operation symbols+ ,"backslash","times","divide","circ","oplus","otimes","sum","prod","wedge"+ ,"bigwedge","vee","bigvee","cup","bigcup","cap","bigcap"++ -- Relation symbols+ ,"ne","le","leq","ge","geq","prec","succ","notin","subset","supset"+ ,"subseteq","supseteq","equiv","cong","approx","propto"++ -- Logical symbols+ ,"neg","implies","iff","exists","bot","top","vdash","models"++ -- Grouping brackets+ ,"langle","rangle"++ -- Miscellaneous symbols+ ,"int","oint","partial","nabla","pm","emptyset","infty","aleph","ldots"+ ,"cdots","vdots","ddots","quad","diamond","square","lfloor","rfloor","lceiling","rceiling"++ -- Standard functions+ ,"sin","cos","tan","csc","sec","cot","sinh","cosh","tanh","log"+ ,"ln","det","dim","lim","mod","gcd","lcm","liminf","inf","limsup"+ ,"max","min","Pr"++ -- Arrows+ ,"uparrow","downarrow","rightarrow","to","leftarrow"+ ,"leftrightarrow","Rightarrow","Leftarrow","Leftrightarrow"+ ]++ mathCmdsArg =+ [-- Font commands+ "mathbf","mathbb","mathcal","mathtt","mathfrak"+ -------+ ,"pmod"+ -- Putting one thing above another+ ,"tilde", "hat", "check", "breve", "acute", "grave", "bar", "vec"+ , "dot", "ddot", "overbrace", "underbrace"+ ,"overline","underline","widehat","widetilde","imath","jmath"+ ]++ typeStyles :: [String]+ typeStyles = ["em","bf","sf","sl","sc","it","tt"]++ allTexDecls = typeStyles++ mathDecls = ["displaystyle", "textstyle", "scriptstyle", "scriptscriptstyle"+ ,"mit","cal"+ ]++ lowerName :: String -> Name+ lowerName name | isLower (head name) = mkName name+ | otherwise = mkName $ '_':name++ mkMathCmd (name, cmd) =+ let lname = lowerName name+ in+ [sigD lname [t| MathItem |]+ , valD (varP lname) (normalB [| mathCmd $(stringE cmd) |]) []+ ]++ mkMathCmdArg name =+ let lname = lowerName name in+ [sigD lname [t| MathItem -> MathItem |]+ , valD (varP lname) (normalB [| mathCmdArg $(stringE name) |]) []+ ]++ mkTexDecl name =+ let lname = lowerName name in+ [sigD lname [t| LatexItem |]+ , valD (varP lname) (normalB [| texDecl $(stringE name) [] |]) []+ ]++ mkMathDecl name =+ let lname = lowerName name in+ [sigD lname [t| MathItem |]+ , valD (varP lname) (normalB [| mathDecl $(stringE name) [] |]) []+ ]++ mkList name ty names =+ [sigD name ty+ ,valD (varP name) (normalB (listE $ map (varE . lowerName) names)) []]++ d = sequence $ concat $ concat+ [ map mkMathCmd mathCmds+ , map mkMathCmdArg mathCmdsArg+ , map mkTexDecl allTexDecls+ , map mkMathDecl mathDecls+ , [mkList (mkName "mathItems") [t| [MathItem] |] $ (map fst mathCmds ++ mathDecls)]+ , [mkList (mkName "mathCmdsArg") [t| [MathItem -> MathItem] |] mathCmdsArg]+ , [mkList (mkName "allTexDecls") [t| [LatexItem] |] allTexDecls]+ ]+ in do dd <- d+ runIO $ writeFile "/tmp/a.hs" $ pprint dd+ return []+ )+ -}++{- This chunk was generated by the previous TH splice.+ The lists of all commands are manually maintained though. -}+author, title, subtitle, date, institute :: LatexItem -> PreambleItem+title = preambleCmdArg "title" . latexItem+subtitle = preambleCmdArg "subtitle" . latexItem+date = preambleCmdArg "date" . latexItem+author = preambleCmdArg "author" . latexItem+-- Institute is defined in beamer but not in article.+-- Should we move these definitions into sub modules?+-- For instance Language.LaTeX.Article.date+institute = preambleCmdArg "institute" . latexItem++authors :: [LatexItem] -> PreambleItem+authors = author . mconcat . intersperse (rawTex " & ")++utf8 :: Encoding+utf8 = rawEncoding "utf8"++latin1 :: Encoding+latin1 = rawEncoding "latin1"++inputenc :: Encoding -> PreambleItem+inputenc (Encoding enc)+ = usepackage [latexItem $ fromString enc] (pkgName "inputenc")++{-# DEPRECATED em "Use emph instead" #-}+em :: TexDecl+em = texDecl "em"+{-# DEPRECATED rm "Use textrm or rmfamily instead" #-}+rm :: TexDecl+rm = texDecl "rm"+{-# DEPRECATED bf "Use textbf or bfseries instead" #-}+bf :: TexDecl+bf = texDecl "bf"+{-# DEPRECATED sf "Use textsf or sffamily instead" #-}+sf :: TexDecl+sf = texDecl "sf"+{-# DEPRECATED sl "Use textsl or slshape instead" #-}+sl :: TexDecl+sl = texDecl "sl"+{-# DEPRECATED sc "Use textsc or scshape instead" #-}+sc :: TexDecl+sc = texDecl "sc"+{-# DEPRECATED it "Use textit or itshape instead" #-}+it :: TexDecl+it = texDecl "it"+{-# DEPRECATED tt "Use texttt or ttfamily instead" #-}+tt :: TexDecl+tt = texDecl "tt"+-- \up ?++allTexDecls :: [TexDecl]+allTexDecls = [rm, em, bf, sf, sl, sc, it, tt+ ,rmfamily, bfseries, sffamily, slshape+ ,scshape, itshape, ttfamily, upshape, normalfont+ ,reversemarginpar,normalmarginpar+ ,sloppy, fussy,samepage+ ,tiny, scriptsize, footnotesize, small, normalsize, large+ ,_LARGE, _Large, huge, _Huge]++-- Local definitions++check0to4 :: String -> Maybe Int -> LatexM [Arg AnyItem]+check0to4 _ Nothing = return []+check0to4 s (Just n)+ | n >= 0 && n <= 4 = return [optional $ num n]+ | otherwise = throwError $ s ++ ": option must be between 0 and 4 not " ++ show i
+ Language/LaTeX/Builder/Babel.hs view
@@ -0,0 +1,44 @@+-- TODO add more langs+module Language.LaTeX.Builder.Babel+ (Lang, BabelOpt+ ,useBabel+ ,langName+ ,otherlanguage+ -- langs+ ,francais+ ,french+ -- last resort+ ,customLang+ ,customBabelOpt+ ,pkg+ ) where++import Data.String+import Language.LaTeX.Types+import qualified Language.LaTeX.Builder.Internal as BI++newtype BabelOpt = BabelOpt { babelOpt :: AnyItem }++newtype Lang = Lang { langName :: String }+ deriving (Show, Eq)++francais, french :: Lang+francais = Lang "francais"+french = Lang "french"++customLang :: String -> Lang+customLang = Lang++customBabelOpt :: AnyItem -> BabelOpt+customBabelOpt = BabelOpt++pkg :: PackageName+pkg = BI.pkgName "babel"++useBabel :: Lang -> [BabelOpt] -> PreambleItem+useBabel lang opts = BI.usepackage (BI.latexItem (fromString (langName lang))+ : map babelOpt opts) pkg++-- | Switch locally to another language+otherlanguage :: Lang -> ParItem -> ParItem+otherlanguage lang = BI.parEnvironmentPar "otherlanguage" [BI.mandatoryLatexItem (fromString (langName lang))]
+ Language/LaTeX/Builder/Beamer.hs view
@@ -0,0 +1,433 @@+{-# LANGUAGE QuasiQuotes #-}+module Language.LaTeX.Builder.Beamer++where++import Language.LaTeX.Builder.MonoidUtils+import Language.LaTeX.Types+import qualified Language.LaTeX.Builder.Internal as BI+import qualified Language.LaTeX.Builder as B+import Language.LaTeX.Builder.QQ+import Control.Applicative+import Data.List (intersperse)+import Data.Maybe+import Data.Monoid++{-+pkg :: PackageName+pkg = B.pkgName "beamer"+-}++data DocClassOption = Compress+ | T+ | Red+ | Handout+ | RawDocClassOption String++compress, t, red, handout :: DocClassOption+compress = Compress+t = T+red = Red+handout = Handout++rawDocClassOption :: String -> DocClassOption+rawDocClassOption = RawDocClassOption++showDocClassOption :: DocClassOption -> String+showDocClassOption Compress = "compress"+showDocClassOption T = "t"+showDocClassOption Red = "red"+showDocClassOption Handout = "handout"+showDocClassOption (RawDocClassOption x) = x++documentclasskind :: DocumentClassKind+documentclasskind = OtherDocumentClassKind "beamer"++beamer :: Maybe LatexLength -> [DocClassOption] -> [AnyItem] -> DocumentClass+beamer msize opts+ = B.documentclass documentclasskind+ . (maybeToList (BI.texLength <$> msize) ++)+ . (map (BI.rawAnyTex . showDocClassOption) opts ++)++type TargetName = String+type Label = String++labelArg :: Label -> Arg AnyItem+labelArg = BI.mandatoryLatexItem . BI.rawTex++targetArg :: TargetName -> Arg AnyItem+targetArg = BI.mandatoryLatexItem . BI.rawTex++data FrameOpt = Label Label+ | Fragile+ | OtherOption String String+ deriving (Eq,Ord)++data OverlayInt = OvInt Int+ | OvPlus+ | OvPlusOffset Int+ | OvDot+ deriving (Eq,Ord)++-- | Only overlay actions are not supported currently.+data Overlay = OvSingle OverlayInt+ | OvFromTo OverlayInt OverlayInt+ | OvFrom OverlayInt+ deriving (Eq,Ord)++type Overlays = [Overlay]++type BeamerOpt = (String, String)++texFrameOpt :: FrameOpt -> BeamerOpt+texFrameOpt (Label lbl) = ("label",lbl)+texFrameOpt Fragile = ("fragile","")+texFrameOpt (OtherOption a b) = (a,b)++texFrameOpts :: [FrameOpt] -> Arg AnyItem+texFrameOpts = beamerOpts . map texFrameOpt++showOvInt :: OverlayInt -> ShowS+showOvInt (OvInt i) = shows i+showOvInt OvPlus = ('+':)+showOvInt OvDot = ('.':)+showOvInt (OvPlusOffset off) = ('+':) . ('(':) . shows off . (')':)++showOverlay :: Overlay -> ShowS+showOverlay (OvSingle i) = showOvInt i+showOverlay (OvFromTo i j) = showOvInt i . ('-':) . showOvInt j+showOverlay (OvFrom i) = showOvInt i . ('-':)++showOverlays :: Overlays -> Maybe String+showOverlays [] = Nothing+showOverlays ovs = Just . ('<':) . (++">") . showsOv ovs $ []+ where+ showsOv :: Overlays -> ShowS+ showsOv = mconcat . intersperse (',':) . map showOverlay++texOverlaysOpt :: Overlays -> Maybe LatexItem+texOverlaysOpt = fmap BI.rawTex . showOverlays++texOverlaysArg :: Overlays -> Arg a+texOverlaysArg = maybe BI.noArg BI.rawArg . showOverlays++texOverlaysOptArg :: Overlays -> Arg AnyItem+texOverlaysOptArg = maybe BI.noArg (BI.optionalLatexItem . BI.rawTex) . showOverlays++label :: Label -> FrameOpt+label = Label++-- more options to add ?+frame :: Overlays -> Overlays -> [FrameOpt] -> LatexItem -> LatexItem -> ParItem -> ParItem+frame ov mov fopts title subtitle =+ {- recent beamer versions+ BI.parEnvironmentPar "frame" $ [ texOverlaysArg ov+ , maybe BI.noArg BI.optional $ texOverlaysOpt mov+ , texFrameOpts fopts+ , BI.mandatory title+ , BI.mandatory subtitle ]+ -}+ BI.parEnvironmentPar "frame" [ texOverlaysArg ov+ , texOverlaysOptArg mov+ , texFrameOpts fopts+ ] . (mapNonEmpty frametitle title ⊕)+ . (mapNonEmpty framesubtitle subtitle ⊕)++frameO :: Overlays -> ParItem -> ParItem+frameO overlays = BI.parEnvironmentPar "frame" [texOverlaysOptArg overlays]++example :: ParItem -> ParItem+example = BI.parEnvironmentPar "example" []++theorem :: ParItem -> ParItem+theorem = BI.parEnvironmentPar "theorem" []++block :: LatexItem -> ParItem -> ParItem+block title = BI.parEnvironmentPar "block" [BI.mandatoryLatexItem title]++slide :: LatexItem -> ParItem -> ParItem+slide tit = frame [] [] [] tit ø++slideO :: LatexItem -> Overlays -> ParItem -> ParItem+slideO tit ovs body = frameO ovs (frametitle tit ⊕ body)++frametitle :: LatexItem -> ParItem+frametitle = BI.parCmdArg "frametitle" . BI.latexItem++framesubtitle :: LatexItem -> ParItem+framesubtitle = BI.parCmdArg "framesubtitle" . BI.latexItem++-- | All overlays counting from the given argument (like in @<1->@).+ovFrom :: OverlayInt -> Overlay+ovFrom = OvFrom++-- | All overlays between the given arguments (like in @<1-3>@).+ovFromTo :: OverlayInt -> OverlayInt -> Overlay+ovFromTo = OvFromTo++-- | The single overlay (like in @<1>@).+ovSingle :: OverlayInt -> Overlay+ovSingle = OvSingle++-- | Lift a strictly positive 'Int' to an 'OverlayInt'+ovInt :: Int -> OverlayInt+ovInt i | i > 0 = OvInt i+ | otherwise = error "ovInt: strictly positive Int expected"++{- | The '+' incremental overlay specification (like in @<+->@).++ Beamer User Guide at 8.6.4 Incremental Specifications -}+ovPlus :: OverlayInt+ovPlus = OvPlus++{- | The '.' incremental overlay specification (like in @<.->@).++ Beamer User Guide at 8.6.4 Incremental Specifications -}+ovDot :: OverlayInt+ovDot = OvDot++-- | Handy shortcut for @[ovFrom ovPlus]@ aka @<+->@.+ovIncr :: Overlays+ovIncr = [ovFrom ovPlus]++-- | Handy lifting for a list of strictly positive integers.+ovInts :: [Int] -> Overlays+ovInts = map (ovSingle . ovInt)++alert :: LatexItem -> LatexItem+alert = BI.latexCmdArg "alert"++-- A shortcut for @itemize . texOverlaysOpt@+itemize :: Overlays -> [ListItem] -> ParItem+itemize = B.itemize . texOverlaysOpt+-- A shortcut for @enumerate . texOverlaysOpt@+enumerate :: Overlays -> [ListItem] -> ParItem+enumerate = B.enumerate . texOverlaysOpt+-- A shortcut for @description . texOverlaysOpt@+description :: Overlays -> [ListItem] -> ParItem+description = B.description . texOverlaysOpt++-- AtBeginSubsection, AtBeginSection++pause :: LatexItem+pause = BI.texCmdNoArg "pause"++pause' :: Maybe Int -> LatexItem+pause' = BI.latexCmdArgs "pause" . maybeToList . fmap (BI.optional . BI.rawTex . show)++only :: Overlays -> LatexItem -> LatexItem+only ov arg = BI.latexCmdArgs "only" [texOverlaysArg ov, BI.mandatory arg]++uncover :: Overlays -> LatexItem -> LatexItem+uncover ov arg = BI.latexCmdArgs "uncover" [texOverlaysArg ov, BI.mandatory arg]++visible :: Overlays -> LatexItem -> LatexItem+visible ov arg = BI.latexCmdArgs "visible" [texOverlaysArg ov, BI.mandatory arg]++invisible :: Overlays -> LatexItem -> LatexItem+invisible ov arg = BI.latexCmdArgs "invisible" [texOverlaysArg ov, BI.mandatory arg]++alt :: Overlays -> LatexItem -> LatexItem -> LatexItem+alt ov arg1 arg2 = BI.latexCmdArgs "alt" [texOverlaysArg ov, BI.mandatory arg1, BI.mandatory arg2]++temporal :: Overlays -> LatexItem -> LatexItem -> LatexItem -> LatexItem+temporal ov arg1 arg2 arg3+ = BI.latexCmdArgs "temporal" [ texOverlaysArg ov+ , BI.mandatory arg1+ , BI.mandatory arg2+ , BI.mandatory arg3+ ]++visibleenv :: Overlays -> ParItem -> ParItem+visibleenv ov = BI.parEnvironmentPar "visibleenv" [texOverlaysArg ov]++invisibleenv :: Overlays -> ParItem -> ParItem+invisibleenv ov = BI.parEnvironmentPar "invisibleenv" [texOverlaysArg ov]++uncoverenv :: Overlays -> ParItem -> ParItem+uncoverenv ov = BI.parEnvironmentPar "uncoverenv" [texOverlaysArg ov]++onlyenv :: Overlays -> ParItem -> ParItem+onlyenv ov = BI.parEnvironmentPar "onlyenv" [texOverlaysArg ov]++altenv :: Overlays -- ^ overlay specification+ -> LatexItem -- ^ begin text+ -> LatexItem -- ^ end text+ -> LatexItem -- ^ alternate begin text+ -> LatexItem -- ^ alternate end text+ -> ParItem -- ^ environment contents+ -> ParItem+altenv ov b e ab ae =+ BI.parEnvironmentPar "altenv" [ texOverlaysArg ov+ , BI.mandatoryLatexItem b+ , BI.mandatoryLatexItem e+ , BI.mandatoryLatexItem ab+ , BI.mandatoryLatexItem ae+ ]++beamerOpts :: [BeamerOpt] -> Arg AnyItem+beamerOpts = BI.namedOpts . map f+ where f (x,y) = Named x $ BI.rawAnyTex y++beamerPreambleCmdArgs :: String -> [BeamerOpt] -> LatexItem -> PreambleItem+beamerPreambleCmdArgs name opts arg = BI.preambleCmdArgs name [beamerOpts opts, BI.mandatoryLatexItem arg]++usetheme, usefonttheme, useinnertheme, useoutertheme,+ usecolortheme :: [BeamerOpt] -> LatexItem -> PreambleItem++usetheme = beamerPreambleCmdArgs "usetheme"+usefonttheme = beamerPreambleCmdArgs "usefonttheme"+useinnertheme = beamerPreambleCmdArgs "useinnertheme"+useoutertheme = beamerPreambleCmdArgs "useoutertheme"+usecolortheme = beamerPreambleCmdArgs "usecolortheme"++{- | Draws a button with the given button text .++ Example: @hyperlink [] "somewhere" (beamerbutton "Go somewhere")@++ p97 beamer userguide+-}+beamerbutton :: LatexItem -> LatexItem+beamerbutton = BI.latexCmdArg "beamerbutton"++{- | Draws a button with the given button text. Before the text, a small symbol (usually a+ right-pointing arrow) is inserted that indicates that pressing this button will jump+ to another *area* of the presentation.++ Example: @hyperlink [] "detour" (beamergotobutton "Go to detour")@++ p98 beamer userguide+-}+beamergotobutton :: LatexItem -> LatexItem+beamergotobutton = BI.latexCmdArg "beamergotobutton"++{- | The symbol drawn for this button is usually a double right arrow. Use this button if+ pressing it will skip over a well-defined part of your talk.++ p98 beamer userguide+-}+beamerskipbutton :: LatexItem -> LatexItem+beamerskipbutton = BI.latexCmdArg "beamerskipbutton"++{- | The symbol drawn for this button is usually a left-pointing arrow. Use this button+ if pressing it will return from a detour.++ p98 beamer userguide+-}+beamerreturnbutton :: LatexItem -> LatexItem+beamerreturnbutton = BI.latexCmdArg "beamerreturnbutton"++{- |+ Only one overlay specification may be given. The link text is typeset in the+ usual way. If you click anywhere on this text, you will jump to the slide on+ which the \hypertarget command was used with the parameter target name . If an+ overlay specification is present, the hyperlink (including the link text) is+ completely suppressed on the non-specified slides.++ p99 beamer userguide+-}+hyperlink :: Overlays -> TargetName -> LatexItem -> Overlays -> LatexItem+hyperlink ov1 target linkText ov2 =+ BI.latexCmdAnyArgs "hyperlink" [ texOverlaysArg ov1+ , targetArg target+ , BI.mandatoryLatexItem linkText+ , texOverlaysArg ov2+ ]++againframe :: Overlays -> Overlays -> [FrameOpt] -> Label -> ParItem+againframe ov1 ov2 fopts lbl =+ BI.parCmdArgs "againframe" [ texOverlaysArg ov1+ , texOverlaysArg ov2+ , texFrameOpts fopts+ , labelArg lbl+ ]+++-- | Disable those litte icons at the bottom right of your presentation.+beamertemplatenavigationsymbolsempty :: PreambleItem+beamertemplatenavigationsymbolsempty = BI.preambleCmdArgs "beamertemplatenavigationsymbolsempty" []++type TexDimension = LatexLength++data BeamerSize+ = TextMarginLeft TexDimension+ -- ^ sets a new left margin. This excludes the left sidebar. Thus,+ -- it is the distance between the right edge of the left sidebar and the left edge of the text.+ | TextMarginRight TexDimension+ -- ^ sets a new right margin.+ | SidebarWidthLeft TexDimension+ -- ^ sets the size of the left sidebar. Currently, this command+ -- should be given before a shading is installed for the sidebar canvas.+ | SidebarWidthRight TexDimension+ -- ^ sets the size of the right sidebar.+ | DescriptionWidth TexDimension+ -- ^ sets the default width of description labels, see Beamer User Guide Section 11.1.+ | DescriptionWidthOf LatexItem+ -- ^ sets the default width of description labels to the width of the+ -- text, see Section 11.1.+ | MiniFrameSize TexDimension+ -- ^ sets the size of mini frames in a navigation bar. When two+ -- mini frame icons are shown alongside each other, their left end points are+ -- 'TexDimension' far apart.+ | MiniFrameOffset TexDimension+ -- ^ set an additional vertical offset that is added to the mini+ -- frame size when arranging mini frames vertically.++texBeamerSizeArg :: BeamerSize -> Arg AnyItem+texBeamerSizeArg bs = BI.namedArgs . pure $ case bs of+ TextMarginLeft dim -> n "text margin left" $ BI.texLength dim+ TextMarginRight dim -> n "text margin right" $ BI.texLength dim+ SidebarWidthLeft dim -> n "sidebar width left" $ BI.texLength dim+ SidebarWidthRight dim -> n "sidebar width right" $ BI.texLength dim+ DescriptionWidth dim -> n "description width" $ BI.texLength dim+ DescriptionWidthOf txt -> n "description width of" $ BI.latexItem txt+ MiniFrameSize dim -> n "mini frame size" $ BI.texLength dim+ MiniFrameOffset dim -> n "mini frame offset" $ BI.texLength dim+ where n = Named++setbeamersize :: BeamerSize -> PreambleItem+setbeamersize = BI.preambleCmdArgs "setbeamersize" . pure . texBeamerSizeArg++appendix :: ParItem+appendix = BI.parCmdArgs "appendix" []++-- \setbeamercolor*{titlelike}{parent=structure}++data Footline = Footline { authorPercent :: Percentage+ , titlePercent :: Percentage+ , datePercent :: Maybe Percentage+ , showTotalFrames :: Bool }++defaultFootline :: Footline+defaultFootline = Footline { authorPercent = 34+ , titlePercent = 36+ , datePercent = Nothing+ , showTotalFrames = True }++footline :: Footline -> PreambleItem+footline Footline{authorPercent=authorp,titlePercent=titlep,datePercent=maydatep,showTotalFrames=stf} =+ let datep = fromMaybe (100 - authorp - titlep) maydatep+ f (Percentage p) = BI.rawPreamble $ show p+ maytotalframes = if stf then [qp| / \inserttotalframenumber|] else ø+ in+ [qp|+ | \defbeamertemplate*{footline}{infolines theme without institution}+ | {+ | \leavevmode%+ | \hbox{%+ | \begin{beamercolorbox}[wd=.|] ⊕ f authorp ⊕ [qp|\paperwidth,ht=2.25ex,dp=1.125ex,center]{author in head/foot}%+ | \usebeamerfont{author in head/foot}+ | \insertshortauthor+ | \end{beamercolorbox}%+ | \begin{beamercolorbox}[wd=.|] ⊕ f titlep ⊕ [qp|\paperwidth,ht=2.25ex,dp=1.125ex,center]{title in head/foot}%+ | \usebeamerfont{title in head/foot}+ | \insertshorttitle+ | \end{beamercolorbox}%+ | \begin{beamercolorbox}[wd=.|] ⊕ f datep ⊕ [qp|\paperwidth,ht=2.25ex,dp=1.125ex,right]{date in head/foot}%+ | \usebeamerfont{date in head/foot}+ | \insertshortdate{}\hspace*{2em}+ | \insertframenumber{}|] ⊕ maytotalframes ⊕ [qp|\hspace*{2ex}+ | \end{beamercolorbox}}%+ | \vskip0pt%+ | }+ |]
+ Language/LaTeX/Builder/Color.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE OverloadedStrings #-}+module Language.LaTeX.Builder.Color+ (+ -- * The type of colors+ Color+ -- * Coloring commands+ ,pagecolor+ ,color+ ,textcolor+ ,colorbox+ ,fcolorbox+ ,preamblecolor+ ,normalcolor+ -- * Making colors+ ,named, rgb, cmyk, gray, html, rgb256+ -- * Predefined colors+ ,red, green, blue, black, white, cyan, magenta, yellow, orange+ -- * Package name+ ,pkg)+where++import Data.String+import Data.Word+import Language.LaTeX.Types+import qualified Language.LaTeX.Builder.Internal as BI+import Control.Monad.Error (throwError)++-- Some HTML docs at http://en.wikibooks.org/wiki/LaTeX/Colors++data Color = BaseColor String+ | NamedColor String+ | RGB Rational Rational Rational+ | RGB256 Word8 Word8 Word8+ | HTML String+ | CMYK Rational Rational Rational Rational+ | Gray Rational++colorArgs :: Color -> [Arg AnyItem]+colorArgs = (BI.packageDependency pkg:) . f+ where f (BaseColor n) = [man n]+ f (NamedColor n) = [opt "named", man n]+ f (RGB r g b) = model "rgb" (checkRatios [r,g,b])+ f (RGB256 r g b) = model "RGB" [r,g,b]+ f (CMYK c m y k) = model "cmyk" (checkRatios [c,m,y,k])+ f (Gray g) = model "gray" (checkRatios [g])+ f (HTML s) = [opt "HTML", man . checkHTML $ s]+ opt = BI.optionalLatexItem . fromString+ man = BI.mandatoryLatexItem . fromString+ model name cs = [opt name,+ BI.mandatoryList . map BI.num $ cs]+ check msg p x | p x = x+ | otherwise = error msg+ checkHTML = check "Not a HTML color (6 hex digits)" (\s -> length s == 6 && all (`elem` (['0'..'9']++['a'..'F']++['A'..'F'])) s)+ checkRatios = check "Not a rational number between 0 and 1" (all checkRatio)+ checkRatio x = x >= 0 && x <= 1++red, green, blue, black, white, cyan, magenta, yellow :: Color+[red, green, blue, black, white, cyan, magenta, yellow] =+ map BaseColor ["red", "green", "blue", "black", "white", "cyan", "magenta", "yellow"]++orange :: Color+orange = rgb 1 0.5 0++pkg :: PackageName+pkg = BI.pkgName "color"++named :: String -> Color+named = NamedColor++rgb :: Rational -> Rational -> Rational -> Color+rgb = RGB++cmyk :: Rational -> Rational -> Rational -> Rational -> Color+cmyk = CMYK++gray :: Rational -> Color+gray = Gray++rgb256 :: Word8 -> Word8 -> Word8 -> Color+rgb256 = RGB256++html :: String -> Color+html = HTML++-- | 'pagecolor' sets the background colour for the current and following pages+pagecolor :: Color -> ParItem+pagecolor = BI.parCmdArgs "pagecolor" . colorArgs++-- | 'color' is a declaration to switch to setting text in the given colour+color :: Color -> TexDecl+color = BI.texDecl' "color" . colorArgs++-- | 'textcolor' sets the text of its argument in the given colour+textcolor :: Color -> LatexItem -> LatexItem+textcolor c x = BI.latexCmdAnyArgs "textcolor" (colorArgs c ++ [BI.mandatoryLatexItem x])++-- | 'colorbox' sets its argument in a box with the given colour as background+colorbox :: Color -> LatexItem -> LatexItem+colorbox c x = BI.latexCmdAnyArgs "colorbox" (colorArgs c ++ [BI.mandatoryLatexItem x])++-- | @fcolorbox c1 c2 text@ is like 'colorbox', with a frame of @c1@ around a box+-- of background colour @c2@.+-- For example, @fcolorbox red green "Text"@ sets `Text' in the current text colour+-- on a green background with a red frame.+--+-- The two specifications must either both be defined ones, or both use the same+-- model, which is given only once, this limitation only make sense in LaTeX+-- parlance but is helpful here to understand why this function can fail.+fcolorbox :: Color -> Color -> LatexItem -> LatexItem+fcolorbox c1 c2 x =+ let args =+ case (colorArgs c1, colorArgs c2) of+ ([p, m1, a1], [_, m2, a2]) | m1 == m2 -> [p, m1, a1, a2]+ ([p, a1], [_, a2]) -> [p, a1, a2]+ _ -> [BI.mandatory (AnyItem $ throwError "fcolorbox: arguments must be either of the same model,\+ \ or be defined colors.")]+ in+ BI.latexCmdAnyArgs "fcolorbox" (args ++ [BI.mandatoryLatexItem x])++-- | Like 'color' but usable in the preamble.+preamblecolor :: Color -> PreambleItem+preamblecolor = BI.preambleCmdArgs "color" . colorArgs++-- | 'normalcolor' switches to the colour that was active at the end of the preamble.+-- Thus placing a 'color' declaration in the preamble can change the standard colour+-- for the whole document. This is the equivalent to 'normalfont' for font selection.+normalcolor :: TexDecl+normalcolor = BI.texDecl' "normalcolor" [BI.packageDependency pkg]
+ Language/LaTeX/Builder/Graphics.hs view
@@ -0,0 +1,176 @@+module Language.LaTeX.Builder.Graphics+ (+ -- * The main command+ includegraphics+ -- * The options+ ,IncludeGraphicsOpts(..)+ -- * The locations+ ,Loc, c, center, t, top, l, left, r, right, b, bottom, ba, baseline, tr, topRight+ ,tl, topLeft, bl, bottomLeft, br, bottomRight, baselineLeft, baselineRight+ -- * The package name+ , pkg)+where++import Language.LaTeX.Types hiding (Loc)+import qualified Language.LaTeX.Builder.Internal as BI+import Language.LaTeX.Builder.MonoidUtils ((⊕))+import Control.Arrow ((***))+import Data.Maybe+import Data.String++data Loc = C -- ^ Center+ | T -- ^ Top+ | L -- ^ Left+ | R -- ^ Right+ | B -- ^ Bottom+ | Ba -- ^ Baseline+ | TR -- ^ Top right+ | TL -- ^ Top left+ | BL -- ^ Bottom left (default)+ | BR -- ^ Bottom right+ | BaL -- ^ Baseline left+ | BaR -- ^ Baseline right+ deriving (Eq)++c, center, t, top, l, left, r, right, b, bottom, ba, baseline, tr, topRight,+ tl, topLeft, bl, bottomLeft, br, bottomRight, baselineLeft, baselineRight :: Loc+c = C+center = C+t = T+top = T+l = L+left = L+r = R+right = R+b = B+bottom = B+ba = Ba+baseline = Ba+tr = TR+topRight = TR+tl = TL+topLeft = TL+bl = BL+bottomLeft = BL+br = BR+bottomRight = BR+baselineLeft = BaL+baselineRight = BaR++showGrLoc :: Loc -> String+showGrLoc loc = case loc of+ C -> "c"+ T -> "t"+ L -> "l"+ R -> "r"+ B -> "b"+ Ba -> "B"+ TR -> "tr"+ TL -> "tl"+ BL -> "bl"+ BR -> "br"+ BaL -> "Bl"+ BaR -> "Br"++data IncludeGraphicsOpts = IncludeGraphicsOpts+ { scale :: Rational+ -- ^ the number by which the figure size should be magnified over its natural size+ , width :: Maybe LatexLength+ -- ^ specifies the width to which the figure should be scaled to; if height not given,+ -- it is scaled with the same factor as the width+ , height :: Maybe LatexLength+ -- ^ specifies the height to which the figure should be scaled to; if width is not given,+ -- it is scaled with the same factor as the height+ , totalheight :: Maybe LatexLength+ -- ^ like height but specifies the height plus depth of the figure; should always be used+ -- in place of height if the figure has been otated+ , keepaspectratio :: Bool+ -- ^ if both height and width are specified, this flag ensures that the original height/width+ -- ratio remains unchanged; the figure will not exceed either of the given dimensions+ , angle :: Rational+ -- ^ the angle by which the figure is to be rotated counterclockwise, in degrees; any height+ -- or width specifications coming before this key are also rotated, so that the height becomes+ -- the width, while the width becomes either the height (positive angle) or depth (negative angle)+ , origin :: Loc+ -- ^ determines the point about which the rotation occurs; default is bl for bottom left+ -- corner; also possible are c for center, t for top, r for right, and B for baseline;+ -- any sensible combination, such as tr, is allowed+ , draft :: Bool+ -- ^ like the draft package option but applied to the one graphics file; the figure is not+ -- imported, but rather a framed box of the correct size is printed containing the name of+ -- the file+ , clip :: Bool+ -- ^ suppresses the printing of any graphic outside the bounding box+ , bb :: Maybe (Coord, Coord)+ -- ^ ((llx, lly) (urx, ury)); enters the coordinates of the bounding box manually,+ -- if they are missing or incorrect in the graphics file, or to be deliberately altered;+ -- the specifications are four lengths separated by blanks; units may be given, but if+ -- omitted, big points (bp) are assumed+ , viewport :: Maybe (Coord, Coord)+ -- ^ ((llx, lly), (urx, ury)); specifies the bounding box but relative to the lower left+ -- corner of the existing one; useful for correcting the bounding box, or (with clip) to+ -- select only a portion of the whole figure+ , trim :: Maybe (Coord, Coord)+ -- ^ ((dllx, dlly), (durx, dury)); reduces the existing bounding box by the amounts specified+ , hiresbb :: Bool+ -- ^ like the hiresbb package option but applied to the one graphics file; reads bounding box+ -- information from the %%HiResBoundingBox line in the graphics file. + }++pkg :: PackageName+pkg = PkgName "graphicx"++-- | @includegraphics fopts fp@+-- The @fopts@ function will receive the defaults options and should modify options+-- to suit your needs.+--+-- This function is generally used like this:+-- @+-- includegraphics (\\o -> o{ \<opt\> = \<exp\> ... }) fp+-- @+includegraphics :: (IncludeGraphicsOpts -> IncludeGraphicsOpts) -> FilePath -> ParItem+includegraphics f fp =+ BI.parCmdArgs "includegraphics" $ opt ++ [BI.packageDependency pkg, BI.mandatoryLatexItem $ fromString fp]+ where opts = includeGraphicsOpts $ f defaultOpts+ opt | null opts = []+ | otherwise = [BI.namedOpts opts]++defaultOpts :: IncludeGraphicsOpts+defaultOpts = IncludeGraphicsOpts+ { scale = 1+ , width = Nothing+ , height = Nothing+ , totalheight = Nothing+ , keepaspectratio = False+ , angle = 0+ , origin = baselineLeft+ , draft = False+ , clip = False+ , bb = Nothing+ , viewport = Nothing+ , trim = Nothing+ , hiresbb = False -- I think that's the default.+ }++includeGraphicsOpts :: IncludeGraphicsOpts -> [Named AnyItem]+includeGraphicsOpts o =+ catMaybes [ f "scale" scale BI.rat+ , f "width" width (BI.texLength . fromJust)+ , f "height" height (BI.texLength . fromJust)+ , f "totalheight" totalheight (BI.texLength . fromJust)+ , f "keepaspectratio" keepaspectratio BI.bool+ , f "angle" angle BI.rat+ , f "origin" origin (BI.rawAnyTex . showGrLoc)+ , f "draft" draft BI.bool+ , f "clip" clip BI.bool+ , f "bb" bb maybeCoords+ , f "viewport" viewport maybeCoords+ , f "trim" trim maybeCoords+ , f "hiresbb" hiresbb BI.bool+ ]+ where f :: Eq a => String -> (IncludeGraphicsOpts -> a) -> (a -> AnyItem) -> Maybe (Named AnyItem)+ f name proj toAnyItem+ | proj defaultOpts == proj o = Nothing+ | otherwise = Just (Named name (toAnyItem $ proj o))+ maybeCoords = g . (BI.coord *** BI.coord) . fromJust+ g (x, y) = BI.latexItem $ BI.latexCast x ⊕ BI.rawTex " " ⊕ BI.latexCast y
+ Language/LaTeX/Builder/Internal.hs view
@@ -0,0 +1,355 @@+module Language.LaTeX.Builder.Internal where++import Prelude hiding (sqrt, min, max, lcm, gcd, log, mod, tanh, cosh, tan, sinh,+ sin, cos, succ, sum, pi, mapM)+import qualified Data.List as L+import Data.Maybe+import Data.Monoid+import Data.Traversable (sequenceA, mapM)+import Control.Applicative hiding (optional)+import Control.Monad hiding (mapM)+import Control.Monad.Error (throwError)++import Language.LaTeX.Types+import Language.LaTeX.Builder.MonoidUtils+++{- TODO:+ - robust/fragile/moving+ - tracking savebin in the monad?+ - generating a doc with examples:+ [...("sum", [| sum⊕sub(i⊕eq⊕0)⊕sup infty⊕i⊕sup 2 |])...]+ - pictures+ - choose between optFoo and optionalFoo+ -}++noArg :: Arg a+noArg = NoArg++starArg :: Arg a+starArg = StarArg++starToArg :: Star -> Arg a+starToArg Star = starArg+starToArg NoStar = noArg++mandatory, optional :: a -> Arg a+mandatory = Mandatory . pure+optional = Optional . pure++mandatoryLatexItem, optionalLatexItem :: LatexItem -> Arg AnyItem+mandatoryLatexItem = mandatory . latexItem+optionalLatexItem = optional . latexItem++coordinates :: a -> a -> Arg a+coordinates = Coordinates++mandatoryList :: [a] -> Arg a+mandatoryList = Mandatory++optionals :: [a] -> Arg a+optionals [] = NoArg+optionals xs = Optional xs++named :: String -> a -> Named a+named = Named++namedOpts :: [Named a] -> Arg a+namedOpts [] = NoArg+namedOpts xs = NamedOpts xs++namedArgs :: [Named a] -> Arg a+namedArgs = NamedArgs++optionalLatexItems :: [LatexItem] -> Arg AnyItem+optionalLatexItems = optionals . map latexItem++usepackage :: [AnyItem] -> PackageName -> PreambleItem+usepackage opts pkg =+ preambleCmdArgs "usepackage"+ [providePackage pkg, optionals opts, mandatory (packageName pkg)]++nilNote :: Note+nilNote = stringNote ""++stringNote :: String -> Note+stringNote = TextNote++intNote :: Int -> Note+intNote = IntNote++locNote :: Loc -> Note+locNote = LocNote++-- Note that @rawArg ø@ reduces to ø.+rawArg :: String -> Arg m+rawArg "" = NoArg+rawArg x = RawArg x++-- Note that @liftArg ø@ reduces to ø.+liftArg :: (Eq m, Monoid m) => m -> Arg m+liftArg x | x == ø = NoArg+ | otherwise = LiftArg x++rawDecls :: [TexDecl] -> LatexItem+rawDecls = mapNonEmpty $ fmap TexDecls . sequenceA++texDecl :: String -> TexDecl+texDecl s = pure $ TexDcl s []++texDecl' :: String -> [Arg AnyItem] -> TexDecl+texDecl' s opts = TexDcl s <$> mapM (mapM anyItmM) opts++texDeclOpt :: String -> AnyItem -> TexDecl+texDeclOpt s opt = texDecl' s [optional opt]++parNote :: Key -> Note -> ParItem -> ParItem+parNote k = fmap . ParNote k++parCmdArgs :: String -> [Arg AnyItem] -> ParItem+parCmdArgs x ys = ParCmdArgs x <$> mapM (mapM anyItmM) ys++parCmdArg :: String -> AnyItem -> ParItem+parCmdArg x y = parCmdArgs x [mandatory y]++latexNote :: Key -> Note -> LatexItem -> LatexItem+latexNote k = fmap . LatexNote k++latexCmdArgs :: String -> [Arg LatexItem] -> LatexItem+latexCmdArgs x ys = LatexCmdArgs x <$> mapM sequenceA ys++latexCmdAnyArgs :: String -> [Arg AnyItem] -> LatexItem+latexCmdAnyArgs x ys = LatexCmdAnyArgs x <$> mapM (mapM anyItmM) ys++latexCmdArg :: String -> LatexItem -> LatexItem+latexCmdArg x y = latexCmdArgs x [mandatory y]++latexCmdAnyArg :: String -> AnyItem -> LatexItem+latexCmdAnyArg x y = latexCmdAnyArgs x [mandatory y]++preambleNote :: Key -> Note -> PreambleItem -> PreambleItem+preambleNote k = fmap . PreambleNote k++preambleCmdArgs :: String -> [Arg AnyItem] -> PreambleItem+preambleCmdArgs x ys = PreambleCmdArgs x <$> mapM (mapM anyItmM) ys++preambleCmdArg :: String -> AnyItem -> PreambleItem+preambleCmdArg x y = preambleCmdArgs x [mandatory y]++preambleEnv :: String -> [Arg AnyItem] -> AnyItem -> PreambleItem+preambleEnv x ys = liftM2 (PreambleEnv x) (mapM (mapM anyItmM) ys) . anyItmM++rawPreamble :: String -> PreambleItem+rawPreamble = mapNonEmpty $ pure . RawPreamble++texLength :: LatexLength -> AnyItem+texLength = AnyItem . pure . Length++mandatoryTexLength :: LatexLength -> Arg AnyItem+mandatoryTexLength = mandatory . texLength++optTexLength :: LatexLength -> Arg AnyItem+optTexLength = optional . texLength++latexItem :: LatexItem -> AnyItem+latexItem = AnyItem . fmap LatexItm++mathItem :: MathItem -> AnyItem+mathItem = AnyItem . fmap MathItm . mathItmM++parItem :: ParItem -> AnyItem+parItem = AnyItem . fmap ParItm++preambleItem :: PreambleItem -> AnyItem+preambleItem = AnyItem . fmap PreambleItm++packageName :: PackageName -> AnyItem+packageName = AnyItem . pure . PackageName++locSpecs :: [LocSpec] -> AnyItem+locSpecs = AnyItem . pure . LocSpecs++rawEncoding :: String -> Encoding+rawEncoding = Encoding++pkgName :: String -> PackageName+pkgName = PkgName++packageDependency :: PackageName -> Arg a+packageDependency = PackageAction . PackageDependency++-- This phantom argument states that the given package+-- is considered provided from now on.+-- This especially make sense when building the usepackage+-- command.+providePackage :: PackageName -> Arg a+providePackage = PackageAction . ProvidePackage++showPaper :: LatexPaperSize -> String+showPaper A4paper = "a4paper"+showPaper (OtherPaperSize s) = s++latexPaper :: LatexPaperSize -> AnyItem+latexPaper = rawAnyTex . showPaper++otherDocumentClassKind :: String -> DocumentClassKind+otherDocumentClassKind = OtherDocumentClassKind++bool :: Bool -> AnyItem+bool True = rawAnyTex "true"+bool False = rawAnyTex "false"++coord :: Coord -> AnyItem+coord = AnyItem . pure . Coord++latexSaveBin :: SaveBin -> AnyItem+latexSaveBin = AnyItem . pure . SaveBin++latexCast :: AnyItem -> LatexItem+latexCast = fmap cast . anyItmM+ where cast (LatexItm x) = x+ cast x = LatexCast x++mathCast :: AnyItem -> MathItem+mathCast = MathItem . fmap cast . anyItmM+ where cast (MathItm x) = x+ cast x = MathCast x++parCast :: AnyItem -> ParItem+parCast = fmap cast . anyItmM+ where cast (ParItm x) = x+ cast x = ParCast x++preambleCast :: AnyItem -> PreambleItem+preambleCast = fmap cast . anyItmM+ where cast (PreambleItm x) = x+ cast x = PreambleCast x++latexEnvironmentAny :: String -> [Arg AnyItem] -> AnyItem -> LatexItem+latexEnvironmentAny x ys = liftM2 (Environment x) (mapM (mapM anyItmM) ys) . anyItmM++latexEnvironment :: String -> [Arg AnyItem] -> LatexItem -> LatexItem+latexEnvironment x ys = latexEnvironmentAny x ys . latexItem++latexEnvironmentPar :: String -> [Arg AnyItem] -> ParItem -> LatexItem+latexEnvironmentPar x ys = latexEnvironmentAny x ys . parItem++latexParModeArgs :: String -> [Arg AnyItem] -> ParItem -> LatexItem+latexParModeArgs x ys z = latexCmdAnyArgs x (ys ++ [mandatory (parItem z)])++parEnv :: String -> [Arg AnyItem] -> AnyItem -> ParItem+parEnv x ys = liftM2 (ParEnv x) (mapM (mapM anyItmM) ys) . anyItmM++parEnvironmentPar :: String -> [Arg AnyItem] -> ParItem -> ParItem+parEnvironmentPar x ys = parEnv x ys . parItem++figureLike :: String -> Star -> [LocSpec] -> ParItem -> ParItem+figureLike name star locs+ = parEnvironmentPar (starize name star)+ [optional . locSpecs $ locs] -- liftM $ FigureLike (starize x s) y++listLikeEnv :: String -> [Arg LatexItem] -> [ListItem] -> ParItem+listLikeEnv name opts items =+ parEnvironmentPar name ((map.fmap) latexItem opts)+ (mconcat <$> mapM (fmap mkItem) items)+ where mkItem (ListItm opts' contents) = ParCmdArgs "item" ((map.fmap) LatexItm opts') ⊕ contents++rawTex :: String -> LatexItem+rawTex = mapNonEmpty $ pure . RawTex++rawAnyTex :: String -> AnyItem+rawAnyTex = latexItem . rawTex++rawMath :: String -> MathItem+rawMath = MathItem . pure . RawMath++rawMathChar :: Char -> MathItem+rawMathChar = rawMath . ('{':) . (:"}")++texCmdNoArg :: String -> LatexItem+texCmdNoArg = pure . TexCmdNoArg++latexKey :: Key -> AnyItem+latexKey = AnyItem . pure . Key++latexKeys :: [Key] -> [AnyItem]+latexKeys = map latexKey++latexKeysArg :: [Key] -> Arg AnyItem+latexKeysArg = mandatoryList . latexKeys++latexKeyArg :: Key -> Arg AnyItem+latexKeyArg = mandatory . latexKey++normSpaces :: String -> String+normSpaces = unlines . map (L.unwords . words) . lines++num :: Real a => a -> AnyItem+num = texLength . fromRational . toRational++rat :: Rational -> AnyItem+rat = texLength . fromRational++space :: LatexItem+space = rawTex "{ }"++starize :: String -> Star -> String+starize s NoStar = s+starize s Star = s ++ "*"++-- TODO: make a safe version using a monad+-- http://www.personal.ceu.hu/tex/spacebox.htm#newsavebox+-- fragile+unsafeNewsavebox :: Int -> (SaveBin, LatexItem)+unsafeNewsavebox n =+ let bin = UnsafeMakeSaveBin n+ in (bin, latexCmdAnyArg "newsavebox" $ latexSaveBin bin)++-- sectioning++-- Sectioning commands arguments are 'moving'.+sectioning :: String -> (LatexItem -> ParItem,+ Star -> Maybe LatexItem -> LatexItem -> ParItem)+sectioning name = (sect, sect')+ where sect = sect' ø Nothing+ sect' s opt arg = parCmdArgs (starize name s)+ (maybeToList (fmap (optional . latexItem) opt) +++ [mandatory (latexItem arg)])++-- The array and tablular Environments++tabularLike :: ([RowSpec a] -> [Row a] -> b) -> [RowSpec (LatexM a)] -> [Row (LatexM a)] -> LatexM b+tabularLike f specs rows = do+ spcs <- mapM sequenceA specs+ f spcs <$> (checkRows spcs =<< mapM sequenceA rows)++checkRows :: [RowSpec a] -> [Row a] -> LatexM [Row a]+checkRows specs = mapM checkRow+ where checkRow (Cells cs)+ | cols /= length cs = err "wrong number of cells" cols "different from" (length cs)+ | otherwise = pure $ Cells cs+ checkRow Hline = pure Hline+ checkRow (Cline c1 c2)+ | c1 > cols = err "cline: start column too high" c1 ">" cols+ | c1 < 0 = throwError "tabular: cline: negative start column"+ | c2 > cols = err "cline: end column too high" c2 ">" cols+ | c2 < 0 = throwError "tabular: cline: negative end column"+ | otherwise = pure $ Cline c1 c2+ cols = length $ filter isCol specs+ isCol Rc = True+ isCol Rl = True+ isCol Rr = True+ isCol Rvline = False+ isCol (Rtext _) = False+ err msg x op y = throwError $ L.unwords ["tabular:", msg, '(' : show x, op, show y ++ ")"]++-- `{' `}' are like bgroup plus egroup except that `{' and `}' are+-- syntactically forced to be balanced.+-- begingroup and endgroup only save the scopes of definitions.+-- bgroup and egroup save the scopes as well but also resolve the springs+-- independently.+bgroup, egroup, begingroup, endgroup :: TexDecl+bgroup = texDecl "bgroup"+egroup = texDecl "egroup"+begingroup = texDecl "begingroup"+endgroup = texDecl "endgroup"
+ Language/LaTeX/Builder/Math.hs view
@@ -0,0 +1,877 @@+module Language.LaTeX.Builder.Math++ -- NOTE: do not forget to update allMathItems, allMathDecls+ (amsmath,+ charToMath, stringToMath, mchar, mstring, mathlift, protect, protector, verb,+ _Delta, _Gamma, _Lambda, _Leftarrow, _Leftrightarrow, _Omega, _Phi, _Pi, _Pr,+ _Rightarrow, _Sigma, _Theta, _Xi, acute, aleph, alpha, approx, array, at,+ backslash, bar, beta, between, bigcap, bigcup, bigvee, bigwedge, bmod, bot,+ braces, brackets, breve, bullet, cal, cap, cdots, cdotp, check, chi, circ, cong, cos, cosh,+ cot, csc, cup, ddot, ddots, delta, det, diamond, dim, displaystyle, div, divide,+ dot, downarrow, emptyset, epsilon, eq, neq, equiv, eta, exists, forall_, frac,+ gamma, gcd, ge, geq, grave, group, hat, iff, imath, implies, in_, inf,+ infty, int, iota, jmath, kappa, lambda, langle, lbrace, lceil, lcm,+ ldots, ldotp, le, leftarrow, leftrightarrow, leq, lfloor, lim, liminf, limsup, ln,+ log, lparen, mathBinOp, longleftarrow, longrightarrow, longleftrightarrow,+ mathBinOps, mathCmd, mathCmdArg, mathCmdArgs, mathCmdMathArg, mathCmdMathArgs, mathCmdsArg,+ mathDecl, mathGroup, allMathItems, allMathDecls, rawDecls, decl, decls,+ mathbb, mathbf, mathnormal, mathrm, mathsf, mathit, mathscr,+ mathcal, mathfrak, mathtt, max, mbox, min, mit, mleft, mediumspace,+ negthinspace, mod, models, mrat, mright, msup, thickspace,+ thinspace, mu, nabla, ne, neg, notin, nu, oint, omega, omicron, oplus, otimes,+ overbrace, overline, parenChar, parens, partial, phi, pi, pm, pmod, prec,+ prod, propto, psi, quad, rangle, rbrace, rceil,+ rfloor, rho, rightarrow, rparen, scriptscriptstyle, scriptstyle, sec, sigma, sin, sinh,+ space, sqrt, sqrt', square, stackrel, sub, subset, subseteq, succ, sum, sup,+ supset, supseteq, tan, tanh, tau, text, textstyle, theta, tilde, times, to, top,+ underbrace, underline, uparrow, upsilon, varepsilon, varphi, vartheta, vdash,+ vdots, vec, vee, wedge, widehat, widetilde, xi, zeta,+ a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,+ _A, _B, _C, _D, _E, _F, _G, _H, _I, _J, _K, _L, _M, _N, _O, _P,+ _Q, _R, _S, _T, _U, _V, _W, _X, _Y, _Z,+ _Downarrow, _Uparrow,+ vartriangleright,phantom,++ -- reexports+ cells, cell, vline, hline, cline+ ) where++import Prelude hiding (sqrt, min, max, lcm, gcd, log, mod, tanh, cosh, tan, sinh,+ sin, cos, succ, sum, pi, mapM, div)+import Data.Char+import Data.Maybe (fromMaybe)+import Data.Foldable (foldMap)+import Data.Traversable (sequenceA, mapM)+import Data.String+import qualified Data.IntMap as IntMap+import Control.Arrow+import Control.Applicative+import Control.Monad hiding (mapM)+import Control.Monad.Error (throwError)++import Language.LaTeX.Types+import Language.LaTeX.Builder.MonoidUtils+import Language.LaTeX.Builder (XChar, cell, cells, vline, hline, cline)+import Language.LaTeX.Builder.Internal (rawMath, rawMathChar)+import qualified Language.LaTeX.Builder as B+import qualified Language.LaTeX.Builder.Internal as B++liftMath :: (MathItm -> MathItm) -> MathItem -> MathItem+liftMath fun = MathItem . liftM fun . mathItmM++liftMath2 :: (MathItm -> MathItm -> MathItm) -> MathItem -> MathItem -> MathItem+liftMath2 fun (MathItem aa) (MathItem bb) = MathItem (liftM2 fun aa bb)++group :: MathItem -> MathItem+group = liftMath MathGroup++-- | Same as 'group'+mathGroup :: MathItem -> MathItem+mathGroup = group++mathCmdArgs :: String -> [Arg AnyItem] -> MathItem+mathCmdArgs name args = MathItem $ MathCmdArgs name <$> mapM (mapM anyItmM) args++mathCmdMathArgs :: String -> [Arg MathItem] -> MathItem+mathCmdMathArgs name = mathCmdArgs name . (map . fmap) B.mathItem++mathCmdArg :: String -> AnyItem -> MathItem+mathCmdArg m1 m2 = mathCmdArgs m1 [B.mandatory m2]++mathCmdMathArg :: String -> MathItem -> MathItem+mathCmdMathArg name = mathCmdMathArgs name . pure . B.mandatory++mathDecl :: String -> MathDecl+mathDecl = pure . MathDcl++rawDecls :: [MathDecl] -> MathItem+rawDecls = MathItem . fmap MathDecls . sequenceA++decls :: [MathDecl] -> MathItem -> MathItem+decls ds itm = group (rawDecls ds ⊕ itm)++decl :: MathDecl -> MathItem -> MathItem+decl dcl = decls [dcl]++mathCmd :: String -> MathItem+mathCmd = MathItem . pure . (`MathCmdArgs` [])++mathBinOp :: String -> MathItem -> MathItem -> MathItem+mathBinOp = liftMath2 . MathBinOp++mrat :: Rational -> MathItem+mrat = fromRational++sub, sup :: MathItem -> MathItem+sub = (rawMath "_" ⊕) . mathGroup+sup = (rawMath "^" ⊕) . mathGroup++frac, stackrel :: MathItem -> MathItem -> MathItem+frac m1 m2 = mathCmdMathArgs "frac" [B.mandatory m1,B.mandatory m2]+stackrel m1 m2 = mathCmdMathArgs "stackrel" [B.mandatory m1,B.mandatory m2]++sqrt :: MathItem -> MathItem+sqrt = mathCmdMathArg "sqrt"++sqrt' :: MathItem -> MathItem -> MathItem+sqrt' n1 m1 = mathCmdMathArgs "sqrt" [B.optional n1, B.mandatory m1]++phantom :: MathItem -> MathItem+phantom = mathCmdMathArg "phantom"++mleft, mright :: Char -> MathItem+mleft m1 = MathItem $ RawMath . ("\\left" ⊕) <$> parenChar m1+mright m1 = MathItem $ RawMath . ("\\right" ⊕) <$> parenChar m1++between :: Char -> Char -> MathItem -> MathItem+between opening closing m1 = mleft opening ⊕ m1 ⊕ mright closing++parens, braces, brackets :: MathItem -> MathItem+parens = between '(' ')'+braces = between '{' '}'+brackets = between '[' ']'++parenChar :: Char -> LatexM String+parenChar m1 | m1 `elem` "([.])" = return [m1]+ | m1 == '{' = return "\\{"+ | m1 == '}' = return "\\}"+ | otherwise = throwError $ "invalid parenthesis-like: " ++ show m1++-- NOTE: This command is defined in the amsmath package. It does conflict with+-- some other packages/classes like the JFP class.+-- Maybe this should be move to a Amsmath module+text :: LatexItem -> MathItem+text arg = mathCmdArgs "text" [B.packageDependency amsmath, B.mandatoryLatexItem arg]++mbox :: LatexItem -> MathItem+mbox arg = mathCmdArgs "mbox" [B.mandatoryLatexItem arg]++array :: [RowSpec MathItem] -> [Row MathItem] -> MathItem+array spec items = MathItem $ B.tabularLike MathArray (map (fmap mathItmM) spec)+ (map (fmap mathItmM) items)++-- TODO equation++{- This chunk was extracted from Language.LaTeX.Builder -}+lbrace :: MathItem+lbrace = mathCmd "{"+rbrace :: MathItem+rbrace = mathCmd "}"+lparen :: MathItem+lparen = rawMathChar '('+rparen :: MathItem+rparen = rawMathChar ')'+space :: MathItem+space = mathCmd " "+at :: MathItem+at = mathCmd "@"+in_ :: MathItem+in_ = mathCmd "in"+forall_ :: MathItem+forall_ = mathCmd "forall"+thinspace :: MathItem+thinspace = mathCmd ","+negthinspace :: MathItem+negthinspace = mathCmd "!"++-- \: or \> in LaTeX+mediumspace :: MathItem+mediumspace = mathCmd ":"+thickspace :: MathItem+thickspace = mathCmd ";"+msup :: MathItem+msup = mathCmd "sup"+alpha :: MathItem+alpha = mathCmd "alpha"+beta :: MathItem+beta = mathCmd "beta"+chi :: MathItem+chi = mathCmd "chi"+-- Chi? (don't forget the charToMath table)+delta :: MathItem+delta = mathCmd "delta"+_Delta :: MathItem+_Delta = mathCmd "Delta"+epsilon :: MathItem+epsilon = mathCmd "epsilon"+varepsilon :: MathItem+varepsilon = mathCmd "varepsilon"+eta :: MathItem+eta = mathCmd "eta"+gamma :: MathItem+gamma = mathCmd "gamma"+_Gamma :: MathItem+_Gamma = mathCmd "Gamma"+iota :: MathItem+iota = mathCmd "iota"+kappa :: MathItem+kappa = mathCmd "kappa"+lambda :: MathItem+lambda = mathCmd "lambda"+_Lambda :: MathItem+_Lambda = mathCmd "Lambda"+mu :: MathItem+mu = mathCmd "mu"+nu :: MathItem+nu = mathCmd "nu"+omega :: MathItem+omega = mathCmd "omega"+_Omega :: MathItem+_Omega = mathCmd "Omega"+-- | In LaTeX math mode omicron is just 'o',+-- it is exported as omicron here as well just+-- for convinience.+omicron :: MathItem+omicron = mathCmd "o"+phi :: MathItem+phi = mathCmd "phi"+varphi :: MathItem+varphi = mathCmd "varphi"+_Phi :: MathItem+_Phi = mathCmd "Phi"+pi :: MathItem+pi = mathCmd "pi"+_Pi :: MathItem+_Pi = mathCmd "Pi"+psi :: MathItem+psi = mathCmd "psi"+rho :: MathItem+rho = mathCmd "rho"+sigma :: MathItem+sigma = mathCmd "sigma"+_Sigma :: MathItem+_Sigma = mathCmd "Sigma"+tau :: MathItem+tau = mathCmd "tau"+theta :: MathItem+theta = mathCmd "theta"+vartheta :: MathItem+vartheta = mathCmd "vartheta"+_Theta :: MathItem+_Theta = mathCmd "Theta"+upsilon :: MathItem+upsilon = mathCmd "upsilon"+xi :: MathItem+xi = mathCmd "xi"+_Xi :: MathItem+_Xi = mathCmd "Xi"+zeta :: MathItem+zeta = mathCmd "zeta"+backslash :: MathItem+backslash = mathCmd "backslash"+times :: MathItem+times = mathCmd "times"+div :: MathItem+div = mathCmd "div"+circ :: MathItem+circ = mathCmd "circ"+oplus :: MathItem+oplus = mathCmd "oplus"+otimes :: MathItem+otimes = mathCmd "otimes"+sum :: MathItem+sum = mathCmd "sum"+prod :: MathItem+prod = mathCmd "prod"+wedge :: MathItem+wedge = mathCmd "wedge"+bigwedge :: MathItem+bigwedge = mathCmd "bigwedge"+vee :: MathItem+vee = mathCmd "vee"+bigvee :: MathItem+bigvee = mathCmd "bigvee"+cup :: MathItem+cup = mathCmd "cup"+bigcup :: MathItem+bigcup = mathCmd "bigcup"+cap :: MathItem+cap = mathCmd "cap"+bigcap :: MathItem+bigcap = mathCmd "bigcap"+ne :: MathItem+ne = mathCmd "ne"+le :: MathItem+le = mathCmd "le"+leq :: MathItem+leq = mathCmd "leq"+ge :: MathItem+ge = mathCmd "ge"+geq :: MathItem+geq = mathCmd "geq"+prec :: MathItem+prec = mathCmd "prec"+succ :: MathItem+succ = mathCmd "succ"+notin :: MathItem+notin = mathCmd "notin"+subset :: MathItem+subset = mathCmd "subset"+supset :: MathItem+supset = mathCmd "supset"+subseteq :: MathItem+subseteq = mathCmd "subseteq"+supseteq :: MathItem+supseteq = mathCmd "supseteq"+equiv :: MathItem+equiv = mathCmd "equiv"+cong :: MathItem+cong = mathCmd "cong"+approx :: MathItem+approx = mathCmd "approx"+propto :: MathItem+propto = mathCmd "propto"+neg :: MathItem+neg = mathCmd "neg"+implies :: MathItem+implies = mathCmd "implies"+iff :: MathItem+iff = mathCmd "iff"+exists :: MathItem+exists = mathCmd "exists"+bullet :: MathItem+bullet = mathCmd "bullet"+bot :: MathItem+bot = mathCmd "bot"+top :: MathItem+top = mathCmd "top"+vdash :: MathItem+vdash = mathCmd "vdash"+models :: MathItem+models = mathCmd "models"+langle :: MathItem+langle = mathCmd "langle"+rangle :: MathItem+rangle = mathCmd "rangle"+int :: MathItem+int = mathCmd "int"+oint :: MathItem+oint = mathCmd "oint"+partial :: MathItem+partial = mathCmd "partial"+nabla :: MathItem+nabla = mathCmd "nabla"+pm :: MathItem+pm = mathCmd "pm"+emptyset :: MathItem+emptyset = mathCmd "emptyset"+infty :: MathItem+infty = mathCmd "infty"+aleph :: MathItem+aleph = mathCmd "aleph"+ldots :: MathItem+ldots = mathCmd "ldots"+cdots :: MathItem+cdots = mathCmd "cdots"+vdots :: MathItem+vdots = mathCmd "vdots"+ddots :: MathItem+ddots = mathCmd "ddots"+cdotp :: MathItem+cdotp = mathCmd "cdotp"+ldotp :: MathItem+ldotp = mathCmd "ldotp"+quad :: MathItem+quad = mathCmd "quad"+diamond :: MathItem+diamond = mathCmd "diamond"+square :: MathItem+square = mathCmd "square"+lfloor :: MathItem+lfloor = mathCmd "lfloor"+rfloor :: MathItem+rfloor = mathCmd "rfloor"+lceil :: MathItem+lceil = mathCmd "lceil"+rceil :: MathItem+rceil = mathCmd "rceil"+sin :: MathItem+sin = mathCmd "sin"+cos :: MathItem+cos = mathCmd "cos"+tan :: MathItem+tan = mathCmd "tan"+csc :: MathItem+csc = mathCmd "csc"+sec :: MathItem+sec = mathCmd "sec"+cot :: MathItem+cot = mathCmd "cot"+sinh :: MathItem+sinh = mathCmd "sinh"+cosh :: MathItem+cosh = mathCmd "cosh"+tanh :: MathItem+tanh = mathCmd "tanh"+log :: MathItem+log = mathCmd "log"+ln :: MathItem+ln = mathCmd "ln"+det :: MathItem+det = mathCmd "det"+dim :: MathItem+dim = mathCmd "dim"+lim :: MathItem+lim = mathCmd "lim"+mod :: MathItem+mod = mathCmd "mod"+gcd :: MathItem+gcd = mathCmd "gcd"+lcm :: MathItem+lcm = mathCmd "lcm"+liminf :: MathItem+liminf = mathCmd "liminf"+inf :: MathItem+inf = mathCmd "inf"+limsup :: MathItem+limsup = mathCmd "limsup"+max :: MathItem+max = mathCmd "max"+min :: MathItem+min = mathCmd "min"+_Pr :: MathItem+_Pr = mathCmd "Pr"+uparrow :: MathItem+uparrow = mathCmd "uparrow"+downarrow :: MathItem+downarrow = mathCmd "downarrow"+_Uparrow :: MathItem+_Uparrow = mathCmd "Uparrow"+_Downarrow :: MathItem+_Downarrow = mathCmd "Downarrow"+rightarrow :: MathItem+rightarrow = mathCmd "rightarrow"+longrightarrow :: MathItem+longrightarrow = mathCmd "longrightarrow"+to :: MathItem+to = mathCmd "to"+leftarrow :: MathItem+leftarrow = mathCmd "leftarrow"+longleftarrow :: MathItem+longleftarrow = mathCmd "longleftarrow"+leftrightarrow :: MathItem+leftrightarrow = mathCmd "leftrightarrow"+longleftrightarrow :: MathItem+longleftrightarrow = mathCmd "longleftrightarrow"+_Rightarrow :: MathItem+_Rightarrow = mathCmd "Rightarrow"+_Leftarrow :: MathItem+_Leftarrow = mathCmd "Leftarrow"+_Leftrightarrow :: MathItem+_Leftrightarrow = mathCmd "Leftrightarrow"+-- https://secure.wikimedia.org/wikibooks/en/wiki/LaTeX/Mathematics#Formatting_mathematics_symbols+-- they are said to depend on amsfonts, maybe one should force it+mathnormal, mathrm, mathit, mathbf, mathsf, mathtt, mathbb, mathcal, mathfrak, mathscr :: MathItem -> MathItem+mathnormal = mathCmdMathArg "mathnormal"+mathrm = mathCmdMathArg "mathrm"+mathit = mathCmdMathArg "mathit"+mathbf = mathCmdMathArg "mathbf"+mathsf = mathCmdMathArg "mathsf"+mathtt = mathCmdMathArg "mathtt"+mathcal = mathCmdMathArg "mathcal"+mathfrak = mathCmdMathArg "mathfrak"+mathbb = mathCmdMathArg "mathbb"+mathscr = mathCmdMathArg "mathscr"+pmod :: MathItem -> MathItem+pmod = mathCmdMathArg "pmod"+tilde :: MathItem -> MathItem+tilde = mathCmdMathArg "tilde"+hat :: MathItem -> MathItem+hat = mathCmdMathArg "hat"+check :: MathItem -> MathItem+check = mathCmdMathArg "check"+breve :: MathItem -> MathItem+breve = mathCmdMathArg "breve"+acute :: MathItem -> MathItem+acute = mathCmdMathArg "acute"+grave :: MathItem -> MathItem+grave = mathCmdMathArg "grave"+bar :: MathItem -> MathItem+bar = mathCmdMathArg "bar"+vec :: MathItem -> MathItem+vec = mathCmdMathArg "vec"+dot :: MathItem -> MathItem+dot = mathCmdMathArg "dot"+ddot :: MathItem -> MathItem+ddot = mathCmdMathArg "ddot"+overbrace :: MathItem -> MathItem+overbrace = mathCmdMathArg "overbrace"+underbrace :: MathItem -> MathItem+underbrace = mathCmdMathArg "underbrace"+overline :: MathItem -> MathItem+overline = mathCmdMathArg "overline"+underline :: MathItem -> MathItem+underline = mathCmdMathArg "underline"+widehat :: MathItem -> MathItem+widehat = mathCmdMathArg "widehat"+widetilde :: MathItem -> MathItem+widetilde = mathCmdMathArg "widetilde"+imath :: MathItem -> MathItem+imath = mathCmdMathArg "imath"+jmath :: MathItem -> MathItem+jmath = mathCmdMathArg "jmath"+displaystyle :: MathDecl+displaystyle = mathDecl "displaystyle"+textstyle :: MathDecl+textstyle = mathDecl "textstyle"+scriptstyle :: MathDecl+scriptstyle = mathDecl "scriptstyle"+scriptscriptstyle :: MathDecl+scriptscriptstyle = mathDecl "scriptscriptstyle"+mit :: MathDecl+mit = mathDecl "mit"+cal :: MathDecl+cal = mathDecl "cal"+eq :: MathItem+eq = rawMathChar '='+neq :: MathItem+neq = mathCmd "neq"+a :: MathItem+a = rawMathChar 'a'+b :: MathItem+b = rawMathChar 'b'+c :: MathItem+c = rawMathChar 'c'+d :: MathItem+d = rawMathChar 'd'+e :: MathItem+e = rawMathChar 'e'+f :: MathItem+f = rawMathChar 'f'+g :: MathItem+g = rawMathChar 'g'+h :: MathItem+h = rawMathChar 'h'+i :: MathItem+i = rawMathChar 'i'+j :: MathItem+j = rawMathChar 'j'+k :: MathItem+k = rawMathChar 'k'+l :: MathItem+l = rawMathChar 'l'+m :: MathItem+m = rawMathChar 'm'+n :: MathItem+n = rawMathChar 'n'+o :: MathItem+o = rawMathChar 'o'+p :: MathItem+p = rawMathChar 'p'+q :: MathItem+q = rawMathChar 'q'+r :: MathItem+r = rawMathChar 'r'+s :: MathItem+s = rawMathChar 's'+t :: MathItem+t = rawMathChar 't'+u :: MathItem+u = rawMathChar 'u'+v :: MathItem+v = rawMathChar 'v'+w :: MathItem+w = rawMathChar 'w'+x :: MathItem+x = rawMathChar 'x'+y :: MathItem+y = rawMathChar 'y'+z :: MathItem+z = rawMathChar 'z'+_A :: MathItem+_A = rawMathChar 'A'+_B :: MathItem+_B = rawMathChar 'B'+_C :: MathItem+_C = rawMathChar 'C'+_D :: MathItem+_D = rawMathChar 'D'+_E :: MathItem+_E = rawMathChar 'E'+_F :: MathItem+_F = rawMathChar 'F'+_G :: MathItem+_G = rawMathChar 'G'+_H :: MathItem+_H = rawMathChar 'H'+_I :: MathItem+_I = rawMathChar 'I'+_J :: MathItem+_J = rawMathChar 'J'+_K :: MathItem+_K = rawMathChar 'K'+_L :: MathItem+_L = rawMathChar 'L'+_M :: MathItem+_M = rawMathChar 'M'+_N :: MathItem+_N = rawMathChar 'N'+_O :: MathItem+_O = rawMathChar 'O'+_P :: MathItem+_P = rawMathChar 'P'+_Q :: MathItem+_Q = rawMathChar 'Q'+_R :: MathItem+_R = rawMathChar 'R'+_S :: MathItem+_S = rawMathChar 'S'+_T :: MathItem+_T = rawMathChar 'T'+_U :: MathItem+_U = rawMathChar 'U'+_V :: MathItem+_V = rawMathChar 'V'+_W :: MathItem+_W = rawMathChar 'W'+_X :: MathItem+_X = rawMathChar 'X'+_Y :: MathItem+_Y = rawMathChar 'Y'+_Z :: MathItem+_Z = rawMathChar 'Z'++vartriangleright :: MathItem+vartriangleright = mathCmd "vartriangleright"++bmod :: MathItem -> MathItem -> MathItem+bmod = mathBinOp "bmod"++mathlift :: (LatexItem -> LatexItem) -> MathItem -> MathItem+mathlift fun = text . fun . B.math+{-# DEPRECATED mathlift "The use of M.text should be done with care (mbox is an alternative)" #-}++divide :: MathItem+divide = mathCmd "div"+{-# DEPRECATED divide "Use div instead" #-}++allMathDecls :: [MathDecl]+allMathDecls = [displaystyle, textstyle, scriptstyle, scriptscriptstyle, mit, cal]++allMathItems :: [MathItem]+allMathItems =+ [lbrace, rbrace, space, at, in_, forall_, thinspace, negthinspace, mediumspace,+ thickspace, msup, alpha, beta, chi, delta, _Delta, epsilon, varepsilon, eta,+ gamma, _Gamma, iota, kappa, lambda, _Lambda, mu, nu, omega, _Omega, phi, varphi,+ _Phi, pi, _Pi, psi, rho, sigma, _Sigma, tau, theta, vartheta, _Theta, upsilon,+ xi, _Xi, zeta, backslash, times, div, circ, oplus, otimes, sum, prod, wedge,+ bigwedge, vee, bigvee, cup, bigcup, cap, bigcap, ne, le, leq, ge, geq, prec, succ,+ notin, subset, supset, subseteq, supseteq, equiv, cong, approx, propto, neg, implies,+ iff, exists, bullet, bot, top, vdash, models, langle, rangle, int, oint, partial, nabla, pm,+ emptyset, infty, aleph, ldots, cdots, vdots, ddots, quad, diamond, square, lfloor,+ rfloor, lceil, rceil, sin, cos, tan, csc, sec, cot, sinh, cosh, tanh, log, ln,+ det, dim, lim, mod, gcd, lcm, liminf, inf, limsup, max, min, _Pr, uparrow, downarrow,+ rightarrow, to, leftarrow, leftrightarrow, _Rightarrow, _Leftarrow, _Leftrightarrow+ ,longrightarrow,longrightarrow,longleftrightarrow+ ,vartriangleright, cdotp, ldotp, _Downarrow, _Uparrow+ -- maually added+ ,eq,neq+ ,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z+ ,_A, _B, _C, _D, _E, _F, _G, _H, _I, _J, _K, _L, _M, _N, _O, _P+ ,_Q, _R, _S, _T, _U, _V, _W, _X, _Y, _Z+ ,lparen,rparen+ ]++mathCmdsArg :: [MathItem -> MathItem]+mathCmdsArg = [mathbf, mathbb, mathcal, mathtt, mathfrak, pmod, tilde, hat, check,+ breve, acute, grave, bar, vec, dot, ddot, overbrace, underbrace, overline,+ underline, widehat, widetilde, imath, jmath+ -- maually added+ ,negate+ , sqrt, phantom+ ]++mathBinOps :: [MathItem -> MathItem -> MathItem]+mathBinOps = [(+),(-),(*),bmod]++amsmath :: PackageName+amsmath = PkgName "amsmath"++protector :: XChar -> String -> LatexItem+protector = B.protector . mchar++protect :: String -> LatexItem+protect = protector B.hchar++verb :: String -> LatexItem+verb = protector B.ttchar++{- NOT USED+mchar :: XChar+mchar '\\' = "\\textbackslash{}"+mchar '~' = "\\text{\\~{}}"+mchar '^' = "\\^{}"+mchar ':' = ":"+mchar '_' = "\\_"+mchar x | x `elem` "#&{}$%" = ['\\',x]+ | x `elem` "][" = ['{', x, '}'] -- to avoid mess up optional args+ | otherwise = [x]+-}++type MXChar = Char -> MathItem++-- This char translator transformer only take care of math specific characters.+-- For instance 'a' will be displayed in text mode.+mchar :: XChar -> XChar+mchar xchar ch = maybe (xchar ch) B.math m'+ where m' | isAscii ch && (isAlphaNum ch || isSpace ch) = Nothing+ | otherwise = charToMath ch++-- find a better name and export+mchar' :: XChar -> MXChar+mchar' xchar ch = fromMaybe (mbox (xchar ch)) (charToMath ch)++stringToMath :: String -> MathItem+stringToMath = foldMap $ mchar' B.hchar++mstring :: String -> LatexItem+mstring = B.math . stringToMath++instance IsString MathItem where+ fromString = stringToMath++charToMath :: Char -> Maybe MathItem+charToMath ch+ | isAscii ch && (isAlphaNum ch || isSpace ch) = Just $ rawMathChar ch+ | otherwise = IntMap.lookup (fromEnum ch) mapping+ where+ mapping = IntMap.fromList $ map (first fromEnum)+ [ ('α', alpha)+ , ('β', beta)+ , ('χ', chi)+ , ('δ', delta)+ , ('Δ', _Delta)+ , ('ε', epsilon)+ --, ('', varepsilon)+ , ('η', eta)+ , ('γ', gamma)+ , ('Γ', _Gamma)+ , ('ι', iota)+ , ('κ', kappa)+ , ('λ', lambda)+ , ('Λ', _Lambda)+ , ('μ', mu) -- '\956' mu+ , ('µ', mu) -- '\181' micro sign, is there a specific latex macro for it?+ , ('ν', nu)+ , ('ω', omega)+ , ('Ω', _Omega)+ , ('ο', omicron)+ , ('φ', phi)+ --, ('', varphi)+ , ('Φ', _Phi)+ , ('π', pi)+ , ('Π', _Pi)+ , ('ψ', psi)+ , ('ρ', rho)+ , ('σ', sigma)+ , ('Σ', _Sigma)+ , ('τ', tau)+ , ('θ', theta)+ --, ('', vartheta)+ , ('Θ', _Theta)+ --, ('', upsilon)+ , ('ξ', xi)+ --, ('', _Xi)+ , ('ζ', zeta)+ , ('×', times)+ , ('÷', div)+ , ('·', cdotp)+ , ('∘', circ)+ , ('⊕', oplus)+ , ('⊗', otimes)+ , ('∧', wedge)+ --, ('', bigwedge)+ , ('∨', vee)+ --, ('', bigvee)+ , ('∪', cup)+ --, ('', bigcup)+ --, ('', cap)+ --, ('', bigcap)+ , ('≠', ne)+ --, ('', le)+ , ('≤', leq)+ --, ('', ge)+ , ('≥', geq)+ , ('∈', in_)+ , ('∉', notin)+ , ('⊂', subset)+ , ('⊃', supset)+ , ('⊆', subseteq)+ , ('⊇', supseteq)+ , ('≡', equiv)+ , ('=', eq)+ , ('≠', neq)+ --, ('', cong)+ , ('≈', approx)+ --, ('', propto)+ , ('¬', neg)+ --, ('', iff)+ , ('∀', forall_)+ , ('∃', exists)+ , ('⊥', bot)+ , ('⊤', top)+ , ('⊢', vdash)+ , ('⊩', models)+ , ('⟨', langle)+ , ('⟩', rangle)+ , ('●', bullet)+ {-+ , ('', int)+ , ('', oint)+ , ('', partial)+ , ('', nabla)+ , ('', pm)+ -}+ , ('ø', emptyset)+ , ('∞', infty)+ , ('…', ldots)+ , ('⋯', cdots)+ , ('⋮', vdots)+ {-+ , ('', aleph)+ , ('', ddots)+ , ('', quad)+ , ('', diamond)+ , ('', square)+ -}+ , ('⌈', lceil)+ , ('⌉', rceil)+ , ('⌊', lfloor)+ , ('⌋', rfloor)+ , ('↑', uparrow)+ {-+ , ('', downarrow)+prec+succ+ -}+ , ('→', rightarrow)+ --, ('', to)+ , ('←', leftarrow)+ , ('↔', leftrightarrow)+ , ('⇒', _Rightarrow)+ , ('⇐', _Leftarrow)+ , ('⇔', _Leftrightarrow)+ , ('⟶', longrightarrow)+ , ('⟵', longleftarrow)+ , ('▹', vartriangleright)+ -- black board+ , ('ℕ', mathbb _N)+ , ('ℍ', mathbb _H)+ , ('ℙ', mathbb _P)+ , ('ℝ', mathbb _R)+ , ('ⅅ', mathbb _D)+ , ('ℚ', mathbb _Q)+ , ('ℤ', mathbb _Z)+ --fail/TODO: find the correct definitions+ --, ('ℽ', mathbb gamma)+ --, ('ℾ', mathbb _Gamma)+ --, ('ℿ', mathbb _Pi)+ --, ('⅀', mathbb _Sigma)++ -- mathcal+ , ('℘', mathcal _P)+ , ('ℒ', mathcal _L)+ , ('ℛ', mathcal _R)+ , ('𝒩', mathcal _N)++ ]
+ Language/LaTeX/Builder/MonoidUtils.hs view
@@ -0,0 +1,24 @@+module Language.LaTeX.Builder.MonoidUtils (ø, (⊕), (<>), (<||>), (<&&>), mapNonEmpty) where++import Data.Monoid+import Data.Monoid.Unicode ((⊕))++infixr 5 <>+(<>) :: Monoid m => m -> m -> m+(<>) = mappend++ø :: Monoid m => m+ø = mempty++(<||>) :: (Monoid a, Eq a) => a -> a -> a+a <||> b | a == ø = b+ | otherwise = a++(<&&>) :: (Monoid a, Eq a, Monoid b) => a -> b -> b+a <&&> b | a == ø = ø+ | otherwise = b++mapNonEmpty :: (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b+mapNonEmpty f x | x == ø = ø+ | otherwise = f x+
+ Language/LaTeX/Builder/QQ.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE TemplateHaskell #-}+module Language.LaTeX.Builder.QQ+ (-- * Quasi Quoters+ frQQ,frQQFile,str,strFile,istr,tex,texFile,texm,texmFile,qm,qmFile,qp,qpFile,+ keys,keysFile,+ -- * Building new Quasi Quoters+ mkQQ, mkQQnoIndent, mkQQgen, mkQQFile, indent, noIndent,+ stripIndentQQ,+ -- * Misc functions used by the frquotes expander of «...»+ frTop, frAntiq,+ ) where++import Data.List+import Data.Char+import Data.Functor+import Language.Haskell.TH (Q, Exp, Name, appE, varE, stringE, litP, stringL, valD,+ varP, sigD, mkName, normalB, conE)+import Language.Haskell.TH.Quote+import Language.Haskell.TH.Syntax (Lift(..))+import Language.LaTeX.Types (Key(..))+import Language.LaTeX.Builder.Internal (rawTex, rawPreamble, rawMath)+import Language.LaTeX.Builder.Math (mstring)+import Language.LaTeX.Builder (hstring)++frTop :: a -> a+frTop = id++frAntiq :: a -> a+frAntiq = id++frQQ,frQQFile,str,strFile,istr,tex,texFile,qm,qmFile,qp,qpFile,+ keys, keysFile :: QuasiQuoter++quasiQuoter :: String -> QuasiQuoter+quasiQuoter qqName =+ QuasiQuoter (err "expressions") (err "patterns")+-- if GHC7+ (err "types") (err "declarations")+-- endif+ where err kind _ = fail $ qqName ++ ": not available in " ++ kind++stripIndentQQ :: String -> Q String+stripIndentQQ = fmap unlines' . skipFirst (mapM dropBar . dropLastWhen null . map (dropWhile isSpace)) . lines+ where unlines' = intercalate "\n"+ skipFirst _ [] = return []+ skipFirst f (x:xs) = (x :) <$> f xs+ dropLastWhen _ [] = []+ dropLastWhen p (x:xs) | null xs && p x = []+ | otherwise = x:dropLastWhen p xs+ dropBar ('|':xs) = return xs+ dropBar [] = fail "stripIndentQQ: syntax error '|' expected after spaces (unexpected empty string)"+ dropBar (c:_) = fail $ "stripIndentQQ: syntax error '|' expected after spaces (unexpected "++show c++")"++str = (quasiQuoter "str"){ quoteExp = stringE+ , quotePat = litP . stringL }+strFile = quoteFile str++mkQQgen :: (String -> Q Exp) -> String -> Name -> QuasiQuoter+mkQQgen pre qqName qqFun = (quasiQuoter qqName){ quoteExp = appE (varE qqFun) . pre }++mkQQ :: String -> Name -> QuasiQuoter+mkQQ = mkQQgen indent++mkQQnoIndent :: String -> Name -> QuasiQuoter+mkQQnoIndent = mkQQgen lift++mkQQFile :: (String -> Q Exp) -> String -> Name -> (QuasiQuoter, QuasiQuoter)+mkQQFile pre qqName qqFun = (mkQQgen pre qqName qqFun , quoteFile (mkQQgen lift qqName qqFun))++indent, noIndent :: String -> Q Exp+indent = (lift =<<) . stripIndentQQ+noIndent = lift++-- istr ≡ mkQQ "istr" 'id+istr = (quasiQuoter "istr"){ quoteExp = (stringE =<<) . stripIndentQQ }+-- istrFile makes no sense, use strFile instead++-- | Quasiquoter for raw TeX in math mode+texm, texmFile :: QuasiQuoter++(frQQ, frQQFile) = mkQQFile noIndent "frQQ" 'hstring+(tex, texFile) = mkQQFile indent "tex" 'rawTex+(texm, texmFile) = mkQQFile indent "texm" 'rawMath+(qm, qmFile) = mkQQFile indent "qm" 'mstring+(qp, qpFile) = mkQQFile indent "qp" 'rawPreamble++keys = (quasiQuoter "keys"){ quoteDec = fs } where+ fs = sequence . concatMap f . words+ clean = filter isAlphaNum+ f x = [sigD n [t|Key|]+ ,valD (varP n)+ (normalB (appE (conE 'MkKey) $ stringE x))+ []+ ]+ where n = mkName (clean x)+keysFile = quoteFile keys
+ Language/LaTeX/Builder/Rotating.hs view
@@ -0,0 +1,10 @@+module Language.LaTeX.Builder.Rotating (pkg, turn) where++import Language.LaTeX.Types+import qualified Language.LaTeX.Builder.Internal as BI++pkg :: PackageName+pkg = BI.pkgName "rotating"++turn :: Int -> LatexItem -> LatexItem+turn i = BI.latexEnvironment "turn" [BI.packageDependency pkg, BI.mandatory (BI.num i)]
+ Language/LaTeX/Checker.hs view
@@ -0,0 +1,20 @@+module Language.LaTeX.Checker where++import Data.Set (Set)+import qualified Data.Set as Set+import Data.Generics.Uniplate.Data (universeBi)+import Language.LaTeX.Types++providedPackages :: PreambleItm -> Set PackageName+providedPackages x = Set.fromList [ pkg | ProvidePackage pkg <- universeBi x ]++neededPackages :: Document -> Set PackageName+neededPackages x = Set.fromList [ pkg | PackageDependency pkg <- universeBi x ]++checkDocument :: Document -> Maybe ErrorMessage+checkDocument doc+ | not . null $ missingPkgs = Just ("Missing packages: " ++ show missingPkgs)+ | otherwise = Nothing+ where providedPkgs = providedPackages . documentPreamble $ doc+ neededPkgs = neededPackages doc+ missingPkgs = map getPkgName . Set.toList $ neededPkgs `Set.difference` providedPkgs
+ Language/LaTeX/Length.hs view
@@ -0,0 +1,117 @@+module Language.LaTeX.Length+ (+ -- Units+ inch, pt, em, cm, mm, ex, pc, sp, bp, dd, cc, mu+ -- Dynamic Length+ , stretch+ -- Predefined lengths+ , parindent, textwidth, linewidth, textheight, parsep, parskip, baselineskip+ , baselinestrech, fill, columnsep, columnseprule, mathindent, oddsidemargin+ , evensidemargin, marginparwidth, marginparsep, marginparpush, topmargin+ , headheight, headsep, topskip, footheight, footskip, topsep, partopsep, itemsep+ , itemindent, labelsep, labelwidth, leftmargin, rightmargin, listparindent, jot+ , abovedisplayskip, belowdisplayskip, abovedisplayshortskip+ , belowdisplayshortskip, floatsep, textfloatsep, intextsep, dblfloatsep+ , dbltextfloatsep, textfraction, floatpagefraction, dbltopfaction+ , dblfloatpagefraction, arraycolsep, tabcolsep, arrayrulewidth, doublerulesep+ , arraystretch, bigskipamount, medskipamount, smallskipamount, fboxrule, fboxsep+ )+ where++import Language.LaTeX.Types++inch, pt, em, cm, mm, ex, pc, sp, bp, dd, cc, mu :: Rational -> LatexLength+pt = withUnit Pt+em = withUnit Em+cm = withUnit Cm+mm = withUnit Mm+ex = withUnit Ex+pc = withUnit Pc++-- | Since 'in' is a keyword in Haskell, this one is called 'inch'.+inch = withUnit In+sp = withUnit Sp+bp = withUnit Bp+dd = withUnit Dd+cc = withUnit Cc+mu = withUnit Mu++-- | Internal function to make LatexLength commands+lengthCmd :: String -> LatexLength+lengthCmd = LengthCmd++-- | Internal function to make LatexLength commands+withUnit :: TexUnit -> Rational -> LatexLength+withUnit unit = LengthCst (Just unit)++-- robust+stretch :: Rational -> LatexLength+stretch = LengthCmdRatArg "stretch"++parindent, textwidth, linewidth, textheight, parsep, parskip, baselineskip, baselinestrech,+ fill, columnsep, columnseprule, mathindent, oddsidemargin, evensidemargin, marginparwidth,+ marginparsep, marginparpush, topmargin, headheight, headsep, topskip, footheight, footskip,+ topsep, partopsep, itemsep, itemindent, labelsep, labelwidth, leftmargin, rightmargin,+ listparindent, jot, abovedisplayskip, belowdisplayskip, abovedisplayshortskip,+ belowdisplayshortskip, floatsep, textfloatsep, intextsep, dblfloatsep, dbltextfloatsep,+ textfraction, floatpagefraction, dbltopfaction, dblfloatpagefraction, arraycolsep,+ tabcolsep, arrayrulewidth, doublerulesep, arraystretch, bigskipamount, medskipamount,+ smallskipamount, fboxrule, fboxsep :: LatexLength++parindent = lengthCmd "parindent"+textwidth = lengthCmd "textwidth"+linewidth = lengthCmd "linewidth"+textheight = lengthCmd "textheight"+parsep = lengthCmd "parsep"+parskip = lengthCmd "parskip"+baselineskip = lengthCmd "baselineskip"+baselinestrech = lengthCmd "baselinestrech"+fill = lengthCmd "fill"+columnsep = lengthCmd "columnsep"+columnseprule = lengthCmd "columnseprule"+mathindent = lengthCmd "mathindent"+oddsidemargin = lengthCmd "oddsidemargin"+evensidemargin = lengthCmd "evensidemargin"+marginparwidth = lengthCmd "marginparwidth"+marginparsep = lengthCmd "marginparsep"+marginparpush = lengthCmd "marginparpush"+topmargin = lengthCmd "topmargin"+headheight = lengthCmd "headheight"+headsep = lengthCmd "headsep"+topskip = lengthCmd "topskip"+footheight = lengthCmd "footheight"+footskip = lengthCmd "footskip"+topsep = lengthCmd "topsep"+partopsep = lengthCmd "partopsep"+itemsep = lengthCmd "itemsep"+itemindent = lengthCmd "itemindent"+labelsep = lengthCmd "labelsep"+labelwidth = lengthCmd "labelwidth"+leftmargin = lengthCmd "leftmargin"+rightmargin = lengthCmd "rightmargin"+listparindent = lengthCmd "listparindent"+jot = lengthCmd "jot"+abovedisplayskip = lengthCmd "abovedisplayskip"+belowdisplayskip = lengthCmd "belowdisplayskip"+abovedisplayshortskip = lengthCmd "abovedisplayshortskip"+belowdisplayshortskip = lengthCmd "belowdisplayshortskip"+floatsep = lengthCmd "floatsep"+textfloatsep = lengthCmd "textfloatsep"+intextsep = lengthCmd "intextsep"+dblfloatsep = lengthCmd "dblfloatsep"+dbltextfloatsep = lengthCmd "dbltextfloatsep"+textfraction = lengthCmd "textfraction"+floatpagefraction = lengthCmd "floatpagefraction"+dbltopfaction = lengthCmd "dbltopfaction"+dblfloatpagefraction = lengthCmd "dblfloatpagefraction"+arraycolsep = lengthCmd "arraycolsep"+tabcolsep = lengthCmd "tabcolsep"+arrayrulewidth = lengthCmd "arrayrulewidth"+doublerulesep = lengthCmd "doublerulesep"+arraystretch = lengthCmd "arraystretch"+bigskipamount = lengthCmd "bigskipamount"+medskipamount = lengthCmd "medskipamount"+smallskipamount = lengthCmd "smallskipamount"+fboxrule = lengthCmd "fboxrule"+fboxsep = lengthCmd "fboxsep"+
+ Language/LaTeX/Printer.hs view
@@ -0,0 +1,245 @@+module Language.LaTeX.Printer where++import Data.Monoid+import Data.List (intersperse)+import Data.Ratio (numerator, denominator)+import Data.Foldable (foldMap)+import Data.Char+import GHC.Float (formatRealFloat, FFFormat(FFFixed))++import Language.LaTeX.Types+import Language.LaTeX.Checker (checkDocument)+import Language.LaTeX.Builder.MonoidUtils++optionals :: [a] -> Arg a+optionals [] = NoArg+optionals xs = Optional xs++text :: String -> ShowS+text = showString++between :: String -> String -> ShowS -> ShowS+between opening closing x = text opening ⊕ x ⊕ text closing+++braces, brackets, parens :: ShowS -> ShowS+braces = between "{" "}"+brackets = between "[" "]"+parens = between "(" ")"+++nl, nl2, irrNl, backslash, sp :: ShowS+backslash = text "\\"+nl = text "\n"+nl2 = nl ⊕ nl+sp = text " "+irrNl = text "%\n"++($$) :: ShowS -> ShowS -> ShowS+($$) x y = x ⊕ nl ⊕ y++($$$) :: ShowS -> ShowS -> ShowS+($$$) x y = x ⊕ nl2 ⊕ y++vcat, vcat2 :: [ShowS] -> ShowS+vcat = mconcat . intersperse nl+vcat2 = mconcat . intersperse nl2++ppNamed :: Named ShowS -> ShowS+ppNamed (Named name val)+ | null name = val+ | otherwise = text name ⊕ text "=" ⊕ val++commas :: [ShowS] -> ShowS+commas = mconcat . intersperse (text ",")++ppArg :: Arg ShowS -> ShowS+ppArg NoArg = id+ppArg StarArg = text "*"+ppArg (Optional []) = error "ppArg: impossible: Optional []"+ppArg (NamedOpts []) = error "ppArg: impossible: NamedOpts []"+ppArg (Mandatory xs) = braces . commas $ xs+ppArg (Optional xs) = brackets . commas $ xs+ppArg (NamedArgs xs) = braces . commas . map ppNamed $ xs+ppArg (NamedOpts xs) = brackets . commas . map ppNamed $ xs+ppArg (Coordinates x y) = parens (x ⊕ text " " ⊕ y)+ppArg (LiftArg x) = x+ppArg (RawArg x) = text x+ppArg (PackageAction _) = id++ppEnv :: String -> [Arg ShowS] -> ShowS -> ShowS+ppEnv envName args contents =+ backslash ⊕ begin ⊕ braces envNameS ⊕ mconcat (map ppArg args)+ $$+ contents+ $$+ backslash ⊕ end ⊕ braces envNameS++ where envNameS = text envName+ begin = text "begin"+ end = text "end"++-- these are not wrapped by braces+ppCmdArgs :: String -> [Arg ShowS] -> ShowS+ppCmdArgs cmdName args = backslash ⊕ text cmdName ⊕ mconcat (map ppArg args)++ppDecl :: String -> ShowS -> ShowS+ppDecl declName declArgs = backslash ⊕ text declName ⊕ declArgs ⊕ text " " -- or {}++ppTexDecl :: TexDcl -> ShowS+ppTexDecl (TexDcl declName declArgs) = ppDecl declName (foldMap (ppArg . fmap ppAny) declArgs)++ppMathDecl :: MathDcl -> ShowS+ppMathDecl (MathDcl declName) = ppDecl declName ø++pp :: LatexItm -> ShowS+pp (LatexCmdArgs cmdName args) = ppCmdArgs cmdName $ map (fmap pp) args+pp (LatexCmdAnyArgs cmdName args) = ppCmdArgs cmdName $ map (fmap ppAny) args+pp (TexDecls decls) = foldMap ppTexDecl decls+pp (TexCmdNoArg cmdName) = braces $ ppCmdArgs cmdName []+pp (TexCmdArg cmdName contents)+ = braces (backslash ⊕ text cmdName ⊕ text " " ⊕ pp contents)+pp (Environment envName args contents) = ppEnv envName (map (fmap ppAny) args) $ ppAny contents+pp (RawTex s) = text s+-- One produces $...$ since \(...\) is ``fragile''+pp (LatexCast (MathItm m)) = text "$ " ⊕ ppMath m ⊕ text " $"+pp (LatexCast x) = ppAny x+pp (TexGroup t) = braces $ pp t+pp LatexEmpty = ø+pp (LatexAppend x y) = pp x ⊕ pp y+pp (LatexNote key note t) = ppNote key note pp t++ppParMode :: ParItm -> ShowS+ppParMode (ParCast (MathItm m)) = text "\\[ " ⊕ ppMath m ⊕ text " \\]"+ppParMode (ParCast t) = ppAny t+ppParMode (ParCmdArgs cmdName args) = ppCmdArgs cmdName $ map (fmap ppAny) args+ppParMode (RawParMode x) = text x+ppParMode (ParGroup p) = braces $ ppParMode p+ppParMode (ParEnv envName args contents)+ = ppEnv envName (map (fmap ppAny) args) $ ppAny contents+ppParMode (Tabular specs rows) =+ ppEnv "tabular" [Mandatory . (:[]) . mconcat $ map (ppRowSpec . fmap pp) specs] (ppRows pp rows)+ppParMode (ParConcat contents) = vcat2 $ map ppParMode contents+ppParMode (ParNote key note t) = ppNote key note ppParMode t++ppMath :: MathItm -> ShowS+ppMath (MathDecls decls) = foldMap ppMathDecl decls+ppMath (MathCmdArgs cmdName args) = ppCmdArgs cmdName $ map (fmap ppAny) args+ppMath (RawMath s) = text s+ppMath (MathCast x) = ppAny x+ppMath (MathRat r) | denominator r == 1 = shows (numerator r)+ | otherwise = shows (numerator r) ⊕ text " / " ⊕ shows (denominator r)+ppMath (MathArray specs rows) = + ppEnv "array" [Mandatory . (:[]) . mconcat $ map (ppRowSpec . fmap ppMath) specs] (ppRows ppMath rows)+ppMath (MathGroup m) = braces $ ppMath m+ppMath (MathConcat ms) = mconcat $ map ppMath ms+ppMath (MathUnOp op m) = text op ⊕ sp ⊕ ppMath m+ppMath (MathBinOp op l r) = parens (ppMath l ⊕ sp ⊕ text op ⊕ sp ⊕ ppMath r)+ppMath (MathNote key note m) = ppNote key note ppMath m++ppAny :: AnyItm -> ShowS+ppAny (PreambleItm x) = ppPreamble x+ppAny (LatexItm x) = pp x+ppAny (MathItm x) = ppMath x+ppAny (ParItm x) = ppParMode x+ppAny (LocSpecs locs) = text . map locSpecChar $ locs+ppAny (Key key) = text . getKey $ key+ppAny (Length len) = ppTexLength len+ppAny (Coord (MkCoord x y)) = ppTexLength x ⊕ text " " ⊕ ppTexLength y+ppAny (SaveBin bin) = text $ "\\hlatexSaveBin" ++ (map enc . show $ unsafeGetSaveBin bin)+ where enc i = chr (ord 'a' + digitToInt i) -- hackish but numbers are prohibited+ppAny (PackageName pkg) = text $ getPkgName pkg++ppRowSpec :: RowSpec ShowS -> ShowS+ppRowSpec Rc = text "c"+ppRowSpec Rl = text "l"+ppRowSpec Rr = text "r"+ppRowSpec Rvline = text "|"+ppRowSpec (Rtext x) = text "@" ⊕ braces x+++ppRows :: (a -> ShowS) -> [Row a] -> ShowS+ppRows _ []+ = ø+ppRows ppCell (Cells cells : rows)+ = (mconcat . intersperse (text " & ") . map ppCell $ cells)+ ⊕ (if null rows then ø else backslash ⊕ backslash $$ ppRows ppCell rows)+ppRows ppCell (Hline : rows)+ = backslash ⊕ text "hline " ⊕ ppRows ppCell rows+ppRows ppCell (Cline c1 c2 : rows)+ -- No braces here around the \cline, intentionally+ = ppCmdArgs "cline" [Mandatory . (:[]) . text $ show c1 ++ "-" ++ show c2] ⊕ ppRows ppCell rows++unitName :: TexUnit -> String+unitName u =+ case u of+ Cm -> "cm"+ Mm -> "mm"+ Em -> "em"+ Ex -> "ex"+ Pt -> "pt"+ Pc -> "pc"+ In -> "in"+ Sp -> "sp"+ Bp -> "bp"+ Dd -> "dd"+ Cc -> "cc"+ Mu -> "mu"++ppTexLength :: LatexLength -> ShowS+ppTexLength s =+ case s of+ LengthCmd cmd -> ppCmdArgs cmd []+ LengthCmdRatArg cmd r -> braces $ ppCmdArgs cmd [Mandatory . (:[]) $ showr r]+ LengthScaledBy _ (LengthScaledBy _ _) ->+ error "broken invariant: nested LengthScaledBy"+ LengthScaledBy r l -> showr r ⊕ ppTexLength l+ LengthCst munit r -> showr r ⊕ foldMap (text . unitName) munit+ where showr r | denominator r == 1 = shows $ numerator r+ | otherwise = text $ formatRealFloat FFFixed (Just 2) (fromRational r :: Double)++ppPreamble :: PreambleItm -> ShowS+ppPreamble (PreambleCmdArgs cmdName args) = ppCmdArgs cmdName $ map (fmap ppAny) args+ppPreamble (PreambleEnv envName args contents) = ppEnv envName (map (fmap ppAny) args) (ppAny contents)+ppPreamble (PreambleCast x) = ppAny x+ppPreamble (PreambleConcat ps) = vcat $ map ppPreamble ps+ppPreamble (RawPreamble raw) = text raw+ppPreamble (PreambleNote key note p) = ppNote key note ppPreamble p++ppNote :: Key -> Note -> (a -> ShowS) -> a -> ShowS+ppNote (MkKey key) note ppElt elt = irrNl ⊕ comment (key ⊕ ": " ⊕ showNote note) ⊕ ppElt elt ⊕ irrNl+ where showNote (TextNote s) = s+ showNote (IntNote i) = show i+ showNote (LocNote loc) = showLoc loc+ comment = mconcat . map (text . ('%':) . (⊕ "\n") . stripRight) . lines+ stripRight = reverse . dropWhile isSpace . reverse++showLoc :: Loc -> String+showLoc (Loc fp line char) = unwords [fp, ":", show line, ":", show char]++showDocClassKind :: DocumentClassKind -> String+showDocClassKind Article = "article"+showDocClassKind Book = "book"+showDocClassKind Report = "report"+showDocClassKind Letter = "letter"+showDocClassKind (OtherDocumentClassKind x) = x++preambOfDocClass :: DocumentClss -> PreambleItm+preambOfDocClass (DocClass kind opts) =+ PreambleCmdArgs "documentclass"+ [optionals opts, Mandatory . (:[]) . LatexItm . RawTex $ showDocClassKind kind]++ppDocument :: Document -> ShowS+ppDocument (Document docClass preamb doc) =+ ppPreamble (preambOfDocClass docClass) $$$+ ppPreamble preamb $$$+ ppEnv "document" [] (nl ⊕ ppParMode doc ⊕ nl) ⊕ nl++showsLaTeX :: LatexM Document -> Either ErrorMessage ShowS+showsLaTeX mdoc = do+ doc <- runLatexM mdoc+ maybe (return ()) Left $ checkDocument doc+ return . ppDocument $ doc++showLaTeX :: LatexM Document -> Either ErrorMessage String+showLaTeX = fmap ($"") . showsLaTeX
+ Language/LaTeX/Slicer.hs view
@@ -0,0 +1,46 @@+module Language.LaTeX.Slicer+ (marknote, mark, marker, (^$), slice)+where++import Data.Monoid+import Control.Monad.Writer+import Language.LaTeX.Types+import Language.LaTeX.Builder.MonoidUtils+import qualified Language.LaTeX.Builder.Internal as BI+import qualified Data.Generics.Uniplate.Data as U++marknote :: ParItm+marknote = ParNote (MkKey "slicemark") BI.nilNote ø++mark :: ParItemW+mark = tell $ return marknote++marker :: Writer ParItem a -> Writer ParItem a+marker f = do mark+ x <- f+ mark+ return x++infixr 0 ^$+(^$) :: (b -> Writer ParItem a) -> b -> Writer ParItem a+f ^$ x = marker (f x)++slice :: Functor f => f ParItm -> f ParItm+slice = fmap $ mconcat . mconcat . comb [maySlice1, maySlice2, id] . uncatParItm+ where notMark = (/= marknote)++ -- Is there a mark in a subterm?+ isMarked = any (== marknote) . U.universe++ -- slicing strategy (1): drop until the mark,+ -- drop the mark,+ -- take until the next mark+ maySlice1 = takeWhile notMark . drop 1 . dropWhile notMark++ -- slicing strategy (2):+ -- keep only items which contains a mark as a subterm+ maySlice2 = filter isMarked++ -- Combine multiple strategies:+ -- takes the result of the first succeeding strategy+ comb fs xs = take 1 . filter (not . null) . map ($xs) $ fs
+ Language/LaTeX/Types.hs view
@@ -0,0 +1,523 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, TemplateHaskell,+ DeriveDataTypeable, PatternGuards #-}++-- Those extensions are required by the Uniplate instances.+--{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+module Language.LaTeX.Types where++import Prelude hiding (and, foldr, foldl, foldr1, foldl1, elem, concatMap, concat)+import Data.Monoid (Monoid(..))+import Data.List (intercalate)+import Data.Ratio ((%))+import Data.Traversable+import Data.Foldable+import Data.String (IsString(..))+-- import Data.Generics.PlateTypeable+import Data.Data+import Data.DeriveTH+import Control.Applicative+import Control.Arrow (second)+import Control.Monad.Writer (Writer)+import Control.Monad.Trans ()+import Control.Monad.Error++data Document = Document { documentClass :: DocumentClss+ , documentPreamble :: PreambleItm+ , documentBody :: ParItm }+ deriving (Show, Eq, Typeable, Data)++type LineNumber = Int+type CharNumber = Int++data Loc = Loc { locFile :: FilePath+ , locLine :: LineNumber+ , locChar :: CharNumber+ }+ deriving (Show, Eq, Typeable, Data)++data Note = TextNote String+ | IntNote Int+ | LocNote Loc+ deriving (Show, Eq, Typeable, Data)++data DocumentClassKind = Article+ | Book+ | Report+ | Letter+ | OtherDocumentClassKind String+ deriving (Show, Eq, Typeable, Data)++data DocumentClss+ = DocClass { docClassKind :: DocumentClassKind+ , docClassOptions :: [AnyItm]+ }+ deriving (Show, Eq, Typeable, Data)++data AnyItm = PreambleItm PreambleItm+ | LatexItm LatexItm+ | MathItm MathItm+ | ParItm ParItm+ | LocSpecs [LocSpec]+ | Key Key+ | PackageName PackageName+ | Coord Coord+ | Length LatexLength+ | SaveBin SaveBin+ deriving (Show, Eq, Typeable, Data)++data PreambleItm = PreambleCmdArgs String [Arg AnyItm]+ | PreambleEnv String [Arg AnyItm] AnyItm+ | PreambleCast AnyItm+ | PreambleConcat [PreambleItm]+ | RawPreamble String+ | PreambleNote Key Note PreambleItm+ deriving (Show, Eq, Typeable, Data)++instance Monoid PreambleItm where+ mempty = PreambleConcat []+ PreambleConcat xs `mappend` PreambleConcat ys = PreambleConcat (xs ++ ys)+ PreambleConcat xs `mappend` y = PreambleConcat (xs ++ [y])+ x `mappend` PreambleConcat ys = PreambleConcat (x : ys)+ x `mappend` y = PreambleConcat [x, y]++data TexDcl = TexDcl { texDeclName :: String+ , texDeclArgs :: [Arg AnyItm]+ }+ deriving (Show, Eq, Typeable, Data)++-- This is the subset of tex strings that fits in the LR mode.+-- The distinction between the paragraph and the LR mode is always+-- made explicit using the Para constructor.+--+-- Modes: http://www.personal.ceu.hu/tex/modes.htm+data LatexItm+ = LatexCmdArgs String [Arg LatexItm]+ | LatexCmdAnyArgs String [Arg AnyItm]+ | TexDecls [TexDcl]+ | TexCmdNoArg String+ | TexCmdArg String LatexItm+ | Environment String [Arg AnyItm] AnyItm+ | RawTex String+ | LatexCast AnyItm -- a cast from math induce $...$+ | TexGroup LatexItm+ | LatexEmpty+ | LatexAppend LatexItm LatexItm+ | LatexNote Key Note LatexItm+ deriving (Show, Eq, Typeable, Data)++appendAny :: AnyItm -> AnyItm -> Maybe AnyItm+appendAny (PreambleItm x) (PreambleItm y) = Just $ PreambleItm (x `mappend` y)+appendAny (LatexItm x) (LatexItm y) = Just $ LatexItm (x `mappend` y)+appendAny (MathItm x) (MathItm y) = Just $ MathItm (x `mappend` y)+appendAny (ParItm x) (ParItm y) = Just $ ParItm (x `mappend` y)+appendAny (LocSpecs x) (LocSpecs y) = Just $ LocSpecs (x `mappend` y)+-- this lengthy matching is to get a warning when we extend the AnyItm type+appendAny PreambleItm{} _ = Nothing+appendAny LatexItm{} _ = Nothing+appendAny MathItm{} _ = Nothing+appendAny ParItm{} _ = Nothing+appendAny LocSpecs{} _ = Nothing+appendAny Key{} _ = Nothing+appendAny PackageName{} _ = Nothing+appendAny Coord{} _ = Nothing+appendAny Length{} _ = Nothing+appendAny SaveBin{} _ = Nothing++instance Monoid LatexItm where+ mempty = LatexEmpty -- LatexConcat []+ RawTex xs `mappend` RawTex ys = RawTex (xs ++ ys)+ LatexCast x `mappend` LatexCast y | Just z <- appendAny x y = LatexCast z+ LatexEmpty `mappend` x = x+ x `mappend` LatexEmpty = x+ LatexAppend x y `mappend` z = x `mappend` (y `mappend` z) -- TODO complexity issue?+ x `mappend` LatexAppend y z =+ case x `mappend` y of+ LatexAppend x' y' -> x' `LatexAppend` (y' `mappend` z) -- TODO complexity issue?+ xy -> xy `mappend` z+ x `mappend` y = x `LatexAppend` y++{-+ LatexConcat xs `mappend` LatexConcat ys = LatexConcat (xs ++ ys)+ LatexConcat xs `mappend` y = LatexConcat (xs ++ [y])+ x `mappend` LatexConcat ys = LatexConcat (x : ys)+ x `mappend` y = LatexConcat [x, y]+-}++instance IsString LatexItm where+ fromString s+ | null s = mempty+ | otherwise = f s+ where f = RawTex . concatMap rawhchar . intercalate "\n" . filter (not . null) . lines++data Named a = Named String a+ deriving (Show, Eq, Typeable, Data)++data PackageAction = PackageDependency PackageName+ | ProvidePackage PackageName+ deriving (Show, Eq, Typeable, Data)++data Arg a = NoArg+ | StarArg -- `*'+ | Mandatory [a] -- surrounded by `{' `}', separated by `,'+ | Optional [a] -- surrounded by `[' `]', separated by `,' or empty if null+ | NamedArgs [Named a] -- surrounded by `{' `}', separated by `=` and `,'+ | NamedOpts [Named a] -- surrounded by `[' `]', separated by `=' and `,' or empty if null+ | Coordinates a a -- surrounded by `(' `)', separated by ` '+ | RawArg String+ | LiftArg a+ | PackageAction PackageAction+ deriving (Show, Eq, Typeable, Data)++data Star = Star | NoStar+ deriving (Show, Eq, Typeable, Data)++instance Monoid Star where+ mempty = NoStar+ NoStar `mappend` x = x+ x `mappend` _ = x++data Coord = MkCoord LatexLength LatexLength+ deriving (Show, Eq, Typeable, Data)++newtype Percentage = Percentage { percentage :: Int } deriving (Eq,Show,Ord,Num)++data ParItm = ParCmdArgs String [Arg AnyItm]+ | ParEnv String [Arg AnyItm] AnyItm+ | Tabular [RowSpec LatexItm] [Row LatexItm]+ | RawParMode String+ | ParCast AnyItm -- a cast from Math induce \[...\]+ | ParGroup ParItm -- check validity of this+ | ParConcat [ParItm]+ | ParNote Key Note ParItm+ deriving (Show, Eq, Typeable, Data)++instance Monoid ParItm where+ mempty = ParConcat []+ ParConcat xs `mappend` ParConcat ys = ParConcat (xs ++ ys)+ ParConcat xs `mappend` y = ParConcat (xs ++ [y])+ x `mappend` ParConcat ys = ParConcat (x : ys)+ x `mappend` y = ParConcat [x, y]++unParNote :: ParItm -> Maybe (Key, Note, ParItm)+unParNote (ParNote k n p) = Just (k, n, p)+unParNote _ = Nothing++uncatParItm :: ParItm -> [ParItm]+uncatParItm (ParConcat pars) = pars+uncatParItm par = [par]++newtype MathDcl = MathDcl String+ deriving (Show, Eq, Typeable, Data)++data MathItm = MathDecls [MathDcl]+ | MathCmdArgs String [Arg AnyItm]+ | MathArray [RowSpec MathItm] [Row MathItm]+ | RawMath String+ | MathCast AnyItm+ | MathRat Rational+ | MathGroup MathItm+ | MathConcat [MathItm]+ | MathBinOp String MathItm MathItm+ | MathUnOp String MathItm+ | MathNote Key Note MathItm+ deriving (Show, Eq, Typeable, Data)++instance Monoid MathItm where+ mempty = MathConcat []+ MathConcat xs `mappend` MathConcat ys = MathConcat (xs ++ ys)+ MathConcat xs `mappend` y = MathConcat (xs ++ [y])+ x `mappend` MathConcat ys = MathConcat (x : ys)+ x `mappend` y = MathConcat [x, y]++instance Num MathItm where+ (+) = MathBinOp "+"+ (*) = MathBinOp "*"+ (-) = MathBinOp "-"+ negate = MathUnOp "-"+ abs x = MathCmdArgs "abs" [Mandatory [MathItm x]] -- TODO check+ signum = error "MathItm.signum is undefined"+ fromInteger = MathRat . (%1)++instance Fractional MathItm where+ (/) = MathBinOp "/"+ fromRational = MathRat++{-+instance Real MathItm where+ toRational = error "MathItm.toRational is undefined"++instance Integral MathItm where+ mod = MathBinOp "bmod"+ -- TODO quot, rem+-}++data TexUnit+ = Sp -- ^ Scalled point (1pt = 65536sp)+ | Pt -- ^ Point unit size (1pt = 0.351mm)+ | Bp -- ^ Big point (1in = 72bp), also PostScript point+ | Dd -- ^ Didôt point (1dd = 0.376mm)+ | Em -- ^ One em is about the width of the letter M in the current font+ | Ex -- ^ One ex is about the hoigh of the letter x in the current font+ | Cm -- ^ Centimeter unit size+ | Mm -- ^ Milimeter unit size (1mm = 2.845pt)+ | In -- ^ Inch unit size (1in = 72.27pt)+ | Pc -- ^ Picas (1pc = 12pt)+ | Cc -- ^ Cicero (1dd = 12dd = 4.531mm)+ | Mu -- ^ Math unit (18mu = 1em)+ deriving (Eq, Ord, Enum, Show, Typeable, Data)++data LatexLength = LengthScaledBy Rational LatexLength+ | LengthCmdRatArg String Rational+ | LengthCmd String+ | LengthCst (Maybe TexUnit) Rational+ deriving (Show, Eq, Typeable, Data)++lengthCst :: LatexLength -> Maybe (Maybe TexUnit, Rational)+lengthCst (LengthScaledBy rat len) = second (rat *) <$> lengthCst len+lengthCst (LengthCmdRatArg _ _) = Nothing+lengthCst (LengthCmd _) = Nothing+lengthCst (LengthCst mtu rat) = Just (mtu, rat)++safeLengthOp :: String -> (Rational -> Rational -> Rational) -> LatexLength -> LatexLength -> LatexLength+safeLengthOp _ op (LengthCst Nothing rx) (LengthCst munit ry)+ = LengthCst munit (op rx ry)+safeLengthOp _ op (LengthCst (Just unit) rx) (LengthCst Nothing ry)+ = LengthCst (Just unit) (op rx ry)+safeLengthOp op _ x y+ = error $ "LatexLength." ++ op+ ++ ": undefined on non constants terms (" ++ show x ++ op ++ show y ++ ")"++scaleBy :: Rational -> LatexLength -> LatexLength+scaleBy rx (LengthScaledBy ry l) = LengthScaledBy (rx * ry) l+scaleBy rx (LengthCst munit ry) = LengthCst munit (rx * ry)+scaleBy rx (LengthCmd cmd) = LengthScaledBy rx (LengthCmd cmd)+scaleBy rx (LengthCmdRatArg cmd r) = LengthScaledBy rx (LengthCmdRatArg cmd r)++instance Num LatexLength where+ LengthCst Nothing x * y = scaleBy x y+ x * LengthCst Nothing y = scaleBy y x+ x * y = safeLengthOp "*" (*) x y++ (+) = safeLengthOp "+" (+)+ (-) = safeLengthOp "-" (-)+ negate x = LengthCst Nothing (-1) * x+ abs = error "LatexLength.abs is undefined"+ signum = error "LatexLength.signum is undefined"+ fromInteger = LengthCst Nothing . (%1)++instance Monoid LatexLength where+ mempty = 0+ mappend = (+)++instance Fractional LatexLength where+ x / LengthCst Nothing ry = scaleBy (1/ry) x+ x / y = safeLengthOp "/" (/) x y+ fromRational = LengthCst Nothing++-- p{wd}, and *{num}{cols} are explicitly+-- not supported, it seems much more natural and+-- simple to obtain the same goals using standard+-- programming uppon the rows and cells.+data RowSpec a = Rc --- ^ Centered+ | Rl --- ^ Left+ | Rr --- ^ Right+ | Rvline --- ^ A vertical line+ | Rtext a --- ^ A fixed text column (@-expression in LaTeX parlance)+ deriving (Show, Eq, Typeable, Data)++{-+instance Functor RowSpec where+ _ `fmap` Rc = Rc+ _ `fmap` Rl = Rl+ _ `fmap` Rr = Rr+ _ `fmap` Rvline = Rvline+ f `fmap` (Rtext x) = Rtext $ f x++instance Foldable RowSpec where+ foldr _ z Rc = z+ foldr _ z Rl = z+ foldr _ z Rr = z+ foldr _ z Rvline = z+ foldr f z (Rtext x) = f x z++instance Traversable RowSpec where+ sequenceA Rc = pure Rc+ sequenceA Rl = pure Rl+ sequenceA Rr = pure Rr+ sequenceA Rvline = pure Rvline+ sequenceA (Rtext x) = Rtext <$> x+-}++data LocSpec = Lh --- ^ Here+ | Lt --- ^ Top+ | Lb --- ^ Bottom+ | Lp --- ^ Page of floats: on a sperate page containing no text,+ --- only figures and tables.+ deriving (Show, Eq, Typeable, Data)++locSpecChar :: LocSpec -> Char+locSpecChar Lh = 'h'+locSpecChar Lt = 't'+locSpecChar Lb = 'b'+locSpecChar Lp = 'p'++data Pos = Centered -- ^ Centered (default).+ | FlushLeft -- ^ Flush left+ | FlushRight -- ^ Flush right+ | Stretch -- ^ Stretch (justify) across entire width; text must contain+ -- stretchable space for this to work.++charPos :: Pos -> Char+charPos Centered = 'c'+charPos FlushLeft = 'l'+charPos FlushRight = 'r'+charPos Stretch = 's'++-- TODO: add more paper sizes+data LatexPaperSize = A4paper | OtherPaperSize String+ deriving (Show, Eq, Typeable, Data)++{- NOTE: their is no handling of the \multicolumn command at the moment -}+data Row cell = Cells [cell]+ | Hline+ | Cline Int Int+ deriving (Show, Eq, Typeable, Data)++{-+instance Functor Row where+ f `fmap` Cells cs = Cells (fmap f cs)+ _ `fmap` Hline = Hline+ _ `fmap` Cline i j = Cline i j++instance Foldable Row where+ foldr f z (Cells cs) = foldr f z cs+ foldr _ z Hline = z+ foldr _ z (Cline _ _) = z++instance Traversable Row where+ sequenceA (Cells cs) = Cells <$> sequenceA cs+ sequenceA Hline = pure Hline+ sequenceA (Cline i j) = pure $ Cline i j+-}++data ListItm = ListItm { itemOptions :: [Arg LatexItm], itemContents :: ParItm }++newtype PackageName = PkgName { getPkgName :: String }+ deriving (Ord, Eq, Show, Typeable, Data)++newtype Key = MkKey { getKey :: String }+ deriving (Eq, Show, Typeable, Data)++newtype SaveBin = UnsafeMakeSaveBin { unsafeGetSaveBin :: Int }+ deriving (Eq, Show, Typeable, Data)++data LatexState = LS { freshSaveBin :: SaveBin }++instance (Error a, Eq a, Show a, Num b) => Num (Either a b) where+ fromInteger = pure . fromInteger+ (+) = liftM2 (+)+ (-) = liftM2 (-)+ (*) = liftM2 (*)+ negate = liftM negate+ abs = liftM abs+ signum = liftM signum++instance (Error a, Eq a, Show a, Fractional b) => Fractional (Either a b) where+ (/) = liftM2 (/)+ fromRational = pure . fromRational++type ErrorMessage = String++newtype LatexM a = LatexM { runLatexM :: Either ErrorMessage a }+ deriving (Functor, Applicative, Monad, MonadPlus,+ MonadError ErrorMessage, Show, Eq, Num, Fractional,+ Typeable, Data)++instance Monoid a => Monoid (LatexM a) where+ mempty = pure mempty+ mappend = liftM2 mappend+ mconcat = liftM mconcat . sequenceA++instance IsString a => IsString (LatexM a) where fromString = pure . fromString++type TexDecl = LatexM TexDcl+type LatexItem = LatexM LatexItm+type ParItem = LatexM ParItm+type MathDecl = LatexM MathDcl+newtype AnyItem = AnyItem { anyItmM :: LatexM AnyItm }+ deriving (Eq, Show, Typeable, Data)+newtype MathItem = MathItem { mathItmM :: LatexM MathItm }+ deriving (Monoid, Eq, Show, Num, Fractional, Typeable, Data)++type ListItem = LatexM ListItm+type PreambleItem = LatexM PreambleItm+type DocumentClass = LatexM DocumentClss++type TexDeclW = Writer TexDecl ()+type LatexItemW = Writer LatexItem ()+type ParItemW = Writer ParItem ()+type MathDeclW = Writer MathDecl ()+type MathItemW = Writer MathItem ()+type PreambleItemW = Writer PreambleItem ()++-- TODO: Maybe one should handle quotes in a less LaTeX+-- way: provide a replacement for ``...'' and escape `'"+--+-- NOTE: Don't confuse this function with ttchar+-- NOTE: this raw Tex is ugly+rawhchar :: Char -> String+rawhchar '\\' = "\\textbackslash{}"+rawhchar '<' = "\\textless{}"+rawhchar '>' = "\\textgreater{}"+rawhchar '|' = "\\textbar{}"+rawhchar x+ | x `elem` "~^_#&{}$%" = ['\\',x,'{','}']+ | x `elem` ":][" = ['{', x, '}'] -- '[' and ']' are escaped to avoid mess up optional args+ | otherwise = [x]++-- | Type for encodings used in commands like.+-- @\usepackage[utf8]{inputenc}@, that we can+-- express as 'useInputenc' 'utf8'.+newtype Encoding = Encoding { fromEncoding :: String }+ deriving (Eq,Ord,Show)++-- instance (Integral a, Typeable a, Typeable b, PlateAll a b) => PlateAll (Ratio a) b where+-- plateAll r = plate (%) |+ numerator r |+ denominator r++$(derive makeFunctor ''Named)+$(derive makeFoldable ''Named)+$(derive makeTraversable ''Named)+$(derive makeFunctor ''Arg)+$(derive makeFoldable ''Arg)+$(derive makeTraversable ''Arg)+$(derive makeFunctor ''RowSpec)+$(derive makeFoldable ''RowSpec)+$(derive makeTraversable ''RowSpec)+$(derive makeFunctor ''Row)+$(derive makeFoldable ''Row)+$(derive makeTraversable ''Row)++{-+$(derive makeUniplateTypeable ''SaveBin)+$(derive makeUniplateTypeable ''PackageName)+$(derive makeUniplateTypeable ''Loc)+$(derive makeUniplateTypeable ''Note)+$(derive makeUniplateTypeable ''Arg)+$(derive makeUniplateTypeable ''Key)+$(derive makeUniplateTypeable ''Row)+$(derive makeUniplateTypeable ''RowSpec)+$(derive makeUniplateTypeable ''LocSpec)+$(derive makeUniplateTypeable ''LatexLength)+$(derive makeUniplateTypeable ''Coord)+$(derive makeUniplateTypeable ''DocumentClassKind)++$(derive makeUniplateTypeable ''TexDcl)+$(derive makeUniplateTypeable ''MathItm)+$(derive makeUniplateTypeable ''MathDcl)+$(derive makeUniplateTypeable ''ParItm)+$(derive makeUniplateTypeable ''TexUnit)+$(derive makeUniplateTypeable ''LatexItm)+$(derive makeUniplateTypeable ''DocumentClass)+$(derive makeUniplateTypeable ''PreambleItm)+$(derive makeUniplateTypeable ''Document)+-}
+ Language/LaTeX/Unicode.hs view
@@ -0,0 +1,183 @@+{-# LANGUAGE FlexibleInstances #-}+module Language.LaTeX.Unicode where++import Language.LaTeX.Types+import qualified Language.LaTeX.Builder as B+import qualified Language.LaTeX.Builder.Math as M++{-+ α = alpha)+ β = beta)+ χ = chi)+ δ = delta)+ Δ = _Delta)+ ε = epsilon)+ -- = varepsilon)+ η = eta)+ γ = gamma)+ Γ = _Gamma)+ ι = iota)+ κ = kappa)+ λ = lambda)+ Λ = _Lambda)+ μ = mu)+ ν = nu)+ ω = omega)+ Ω = _Omega)+ ο = omicron)+ φ = phi)+ -- = varphi)+ Φ = _Phi)+ π = pi)+ Π = _Pi)+ ψ = psi)+ ρ = rho)+ σ = sigma)+ Σ = _Sigma)+ τ = tau)+ θ = theta)+ -- = vartheta)+ Θ = _Theta)+ -- = upsilon)+ ξ = xi)+ -- = _Xi)+ ζ = zeta)+-}++class Greek a where+ -- varepsilon+ -- varphi+ -- vartheta+ -- upsilon+ -- _Xi+ α :: a+ β :: a+ χ :: a+ δ :: a+ _Δ :: a+ ε :: a+ η :: a+ γ :: a+ _Γ :: a+ ι :: a+ κ :: a+ λ :: a+ _Λ :: a+ μ :: a+ ν :: a+ ω :: a+ _Ω :: a+ ο :: a+ φ :: a+ _Φ :: a+ π :: a+ _Π :: a+ ψ :: a+ ρ :: a+ σ :: a+ _Σ :: a+ τ :: a+ θ :: a+ _Θ :: a+ ξ :: a+ ζ :: a++instance Greek MathItem where+ α = M.alpha+ β = M.beta+ χ = M.chi+ δ = M.delta+ _Δ = M._Delta+ ε = M.epsilon+ η = M.eta+ γ = M.gamma+ _Γ = M._Gamma+ ι = M.iota+ κ = M.kappa+ λ = M.lambda+ _Λ = M._Lambda+ μ = M.mu+ ν = M.nu+ ω = M.omega+ _Ω = M._Omega+ ο = M.omicron+ φ = M.phi+ _Φ = M._Phi+ π = M.pi+ _Π = M._Pi+ ψ = M.psi+ ρ = M.rho+ σ = M.sigma+ _Σ = M._Sigma+ τ = M.tau+ θ = M.theta+ _Θ = M._Theta+ ξ = M.xi+ ζ = M.zeta++{-+ α = α+ β = β+ χ = χ+ δ = δ+ _Δ = _Δ+ ε = ε+ η = η+ γ = γ+ _Γ = _Γ+ ι = ι+ κ = κ+ λ = λ+ _Λ = _Λ+ μ = μ+ ν = ν+ ω = ω+ _Ω = _Ω+ ο = ο+ φ = φ+ _Φ = _Φ+ π = π+ _Π = _Π+ ψ = ψ+ ρ = ρ+ σ = σ+ _Σ = _Σ+ τ = τ+ θ = θ+ _Θ = _Θ+ ξ = ξ+ ζ = ζ+-}++instance Greek (LatexM LatexItm) where+ α = B.math M.alpha+ β = B.math M.beta+ χ = B.math M.chi+ δ = B.math M.delta+ _Δ = B.math M._Delta+ ε = B.math M.epsilon+ η = B.math M.eta+ γ = B.math M.gamma+ _Γ = B.math M._Gamma+ ι = B.math M.iota+ κ = B.math M.kappa+ λ = B.math M.lambda+ _Λ = B.math M._Lambda+ μ = B.math M.mu+ ν = B.math M.nu+ ω = B.math M.omega+ _Ω = B.math M._Omega+ ο = B.math M.omicron+ φ = B.math M.phi+ _Φ = B.math M._Phi+ π = B.math M.pi+ _Π = B.math M._Pi+ ψ = B.math M.psi+ ρ = B.math M.rho+ σ = B.math M.sigma+ _Σ = B.math M._Sigma+ τ = B.math M.tau+ θ = B.math M.theta+ _Θ = B.math M._Theta+ ξ = B.math M.xi+ ζ = B.math M.zeta
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ doc/user_guide.hs view
@@ -0,0 +1,440 @@+{-# LANGUAGE QuasiQuotes, OverloadedStrings, NoMonomorphismRestriction, UnicodeSyntax #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures -F -pgmF frquotes #-}+import Language.LaTeX+import qualified Language.LaTeX.Length as L+import qualified Language.LaTeX.Builder as B+import qualified Language.LaTeX.Builder.Color as C+import qualified Language.LaTeX.Builder.Math as M+import Language.LaTeX.Builder.QQ hiding (tex)+import Control.Monad.Writer++{- OUTLINE (to put up to date)++Conventions DONE++Monoidal structure PLANNED++Injecting strings+ IsString+ hstring+ reduce hstring "" => mempty++Sectioning++List like env+ how to put a paritem between items++Declarations+ decls are side effects and {} are scopes+ in hlatex all declarations are explicitely scoped (effects don't pass through <>)+ unsafe injection is still available though++Tabulars+ why lists+ format spec+ how put hline+ missing features++Paragraphs+ why strong paragraph distintinction+ no longer double endline meaning+ don't confuse para and paragraph++Math mode+ no strings+ no chars (M.a, M.b...)+ still low level (sum has only one arg)+ still the same meaning for <>+ Ligatures+ num class++Verbatim mode+ why not using the latex verbatim mode+ protect+ special characters+ Ligatures+ Work with fixed width fonts++Figures++Bibliography, glossary and index++Making new commands+ TODO: wrap these functions to+ L.L.Builder.Internal++Raw LaTeX++Pictures++Size units and predefs dimensions+ normalisation, symbolic eval+ num class++The latexm monad+ what for+ how hidden+ a monad transformer would allow+ custom initial monad, more state,+ more control...++The Writer monad+ how to use it++French quotes+ fq is a lexical syntax extension enabling lightweight interpolated literal piece of text. Once desugared this extension relies on the quasi-quoting system provided by GHC.++Misc+ savebins++Packages+ automatic tracking++ graphicx+ listings equivalent++ adding new packages+-}++latex = B._LaTeX+tex = B._TeX+hlatex = B.textsc "HLaTeX" -- TODO make a proper symol and provide it in L.L.Builder+haskell = B.textsc "Haskell"+ast = B.textsc "AST"+ghc = B.textsc "GHC"+math = «mathematics»+mathmode = «math-mode»+frquotes = B.texttt "frquotes"+ltxcode = B.texttt . B.protect+hcode = B.texttt . B.protect+ltxenv = B.texttt . B.protect+ascii = B.textsc "ASCII"++put :: ParItem -> ParItemW+put = tell++p = put . B.para+section = put . B.section+subsection = put . B.subsection+paragraph = put . B.paragraph+em = B.emph++todo = p . C.textcolor C.red++main = quickView myViewOpts { basedir = "examples"+ , pdflatex = "pdflatex"+ , pdfviewer = "evince" }+ "user_guide" doc++doc = B.document (B.book (Just (L.pt 11)) (Just B.a4paper) []) preamb body++preamb = ø+ -- ⊕ B.usepackage [B.optional "francais"] (B.pkgName "babel")++body = execWriter $ do+ put B.tableofcontents++ section «Introduction»++ p «{hlatex} is a library to generate {latex} documents using the {haskell}+ programming language. This library focus on providing a safe set of functions+ and constants that will build a kind of {ast} (abstract syntax tree). This {ast}+ could be subsequently checked and pretty-printed into a final {latex} document,+ ready to feed the {latex} processor.»++ p «The main {latex} advantage is to enable nice typesetting of documents+ without giving up on a human readable/writable text format. However the success+ of {latex} is greatly due to its extensibility. By being a programming language,+ various extensions for all kind of needs appeared as packages. These packages+ provide highlevel typesetting facilities but are themself just using a more+ primitive set of typesetting facilities, and so do not extend the internals of+ the system.»++ p «However as a programming language {latex} has a lot to envy to other+ languages. {tex} ---the underlying system of {latex}--- as a programming+ language, is a system based on macro expansion, lexical conventions are changing+ (dependent of the evaluation), there is no support for data structures, a poor+ support for control structuros, and no type system.»++ p «Hopefully from the point of view of a {latex} generator like {hlatex}, there+ is no need for these programming features. Indeed {hlatex} focus on producing+ {latex} documents without macros definitions. Since {haskell} functions+ superseed {latex} macros, they could be used in replacement, the produced+ {latex} document will be as if the expansion of these new macros was already+ done.»++ paragraph «Safety»++ p «By imposing this restriction ({latex} without macros), {hlatex} turns the+ hard problem of generating correct {latex} into a reasonable one. Indeed safety+ is one of the main goal of this library. Providing safety on the generator side+ has two big advantages. One of them is to avoid the need of looking at the+ generated {latex}, indeed if errors are not reported on the generator but on the+ generatad {latex}, one would have to look at the generatad {latex} and infer+ where is the error in the generator.»++ p «In {hlatex}, errors are classified in two categories. One category of errors+ are caught by the {haskell} type system like the usage of {math} symbols only in+ the {mathmode}, or the distinctions of inline commands like {ltxcode "\\textbf"}+ or {ltxcode "\\hspace»"}, block commands like {ltxenv "itemize"}, dimensions+ like constants in different units, or commands like {ltxcode "\\textwidth"}, and+ others distinctions made using types. All others detected errors are caught+ dynamically before generating the {latex} document, this emcompass for example+ veriications of the numbers of columns in the {ltxenv "tabular"} or+ {ltxenv "array"} environment, and a lot more as the library is being improved.»+ -- TODO cross-references and citations, math mode nestings like a_{b}_{c}...++ section «Design principles»++ subsection «Naming conventions»++ p «{hlatex} tries to stay close to the {latex} concepts and command names. This+ decision should help to find the right function given a {latex} name, however+ this is not always possible since some commands are not valid {haskell}+ identifiers. {latex} names starting with a capital letter will have a leading+ underscore character, for example {ltxcode "\\Rightarrow"} is called+ {hcode "_Rightarrow"}. More precisely since {hlatex} is a {haskell} library,+ function names are not floating around but are packaged in modules, then+ the complete name of {ltxcode "\\Rightarrow"} is+ {hcode "Language.LaTeX.Builder.Math._Rightarrow"}, of course no one wants to+ use it fully qualified. Instead one commonly use {haskell}+ {em «qualified imports»}, importing {hcode "Language.LaTeX.Builder.Math"} as+ simply {hcode "M"}, leading to {hcode "M._Rightarrow"} in a {hlatex} document.+ Likewise the {hcode "Language.LaTeX.Builder"} module is commonly imported as+ {hcode "B"}.»++ p «However some {latex} commands are far from being valid identifiers like+ {math} spacing commands ({ltxcode "\\!"}, {ltxcode "\\,"}, or {ltxcode "\\;"})+ or accents in text mode ({ltxcode "\\'"}, {ltxcode "\\`"}, or {ltxcode "\\."}).+ In these cases, plain names have be chosen like {hcode "M.negthinspace"} or+ {hcode "B.acute"}. These names are chosen according there semantics and not+ according their symbol, so we use `acute' instead of `single quote' and+ `thinspace' instead of `comma'.»++ subsection «Commands with optional arguments»++ p «OUTDATED TODO Since {haskell} does not support optional arguments, and that we do not want+ to add extra burden on the document writer we have choosen to expose two+ variants of some commands. Therefore {ltxcode "\\newline"} is exposed as+ {hcode "B.newline"} and to give the optional size argument one use the+ {hcode "B.newline'"} function as in {hcode "B.newline' (B.pt 42)"}.»+{-Another+ example is sectionning. Each sectionning command (like {ltxcode "\\chapter"} or+ {ltxcode "\\section"}) have an unnumbered version (like {ltxcode "\\chapter*"} or+ {ltxcode "\\section*"}), and can also take an optional argument that is the+ title that will appear in table of contents. So the {hcode "B.chapter"} function+ only take the chapter title whereas the {hcode "B.chapter'"} function takes+ three arguments the first select the normal or the starred version, the second+ is the table of contents version as a {hcode "Maybe"} type and the third is the+ actual title.»+-}++ section «Monoidal structure»++ subsection «FIXME» -- rappel++ p «A monoid is a very simple algebraic structure. To be a monoid one needs a+ set---that will be represented with a {haskell} type---; an associative+ composition operator---called {hcode "mappend"} in {haskell} and abbreviated by+ the {hcode "⊕"} infix operator here; and a neutral element---called+ {hcode "mempty"} and abbreviated using unicode empty set symbol { {-TODO use ø-}B.math M.emptyset }.+ The neutral element is a left and right unit for the composition operator.»++ p «In computer systems a lot of structures are monoid instances. Like lists+ with the empty list and concatenation, integers with zero and addition,+ functions with identity and composition and a lot more.»++ p «The point of using this kind of abstraction instead of their concrete+ representations is to share generic functions over them. For instance composing+ a list of values can be done with the {hcode "mconcat"} function, another+ variants are included in the {hcode "Data.Foldable"} module like the+ {hcode "fold"} and {hcode "foldMap"} functions.»+ -- also add mapNonEmpty when I would have found another name.++{-+ p «»+ p «»+ p «»+ p «»+ p «»+-}++ section «Injecting strings»++ p «While the main job of {hlatex} is to give access to {latex} commands in+ {haskell}, generating documents using {haskell} needs also to cope with+ 80% of the contents, namely the text.»++ p «Plain text can be converted to {latex} using the {hcode "hstring"} function.»++ subsection «The {hcode "hstring"} function»++ p «This function convert an {haskell} string to a piece of {latex}. While the+ semantics of this function is obvious for characters like `a' or `X', what+ the result for blanks, special characters and unicode characters.»++{-+ p «The semantics is clear, {hcode "hstring"} converts each character to a+ {}»+ -}++ todo «note that {hcode "hstring \"\""} reduces to {hcode "ø"}»++ subsection «The IsString class»++ section «Lexical extensions and preprocessing»++ subsection «Activating the extensions»++ let pragmaOpts = "{-# OPTIONS_GHC -F -pgmF frquotes #-}"+ pragmaLang = "{-# LANGUAGE QuasiQuotes, UnicodeSyntax #-}"++ p «Using the following {ghc} pragma {hcode pragmaOpts}, and since this+ extension relies on quasi-quoting one also needs this pragma+ {hcode pragmaLang}.»++ subsection «French Quotes Extension»++ p «{frquotes} is a lexical syntax extension enabling lightweight interpolated + literal piece of text. Once desugared this extension relies on the + quasi-quoting system provided by {ghc}.»++ -- TODO+ p «TO BE UPDATED.+ Currently the French Quotes extension only desugar to litteral strings+ and monoid compositions. French Quotes are introduced using `{«}' and+ closed using `{»}'. Interpolation (injection of {haskell} code inside the+ quotes) is done using braces (`«{»' and `«}»'). These interpolated holes+ can contains an {haskell} expression including nested French Quotes,+ string, comments, braces, etc. The French Quotes characters can be used+ inside French Quotes but must be balanced.»++ subsection «Unicode Syntax Extension»++ p «This syntax extension allows to use `ø' and `⊕' in {haskell}+ code instead {hcode "mempty"} and {hcode "`mappend`"} respectively.+ For example one can write {hcode "ø ⊕ x ⊕ ø"} instead of+ {hcode "mempty `mappend` x `mappend` mempty"}.»+ -- TODO++ section «Sectioning»++ p «In {latex} sectioning is done by inserting separators commands. In {hlatex}+ all these commands are exported in a straightforward way. Most of these commands+ appears in two variants, for instance {ltxcode "\\section"} can be produced+ by {hcode "section"} and just waits for a {hcode "LatexItem"} as title,+ and {hcode "section'"} waits for two extra arguments the first is either+ {hcode "ø"} ({hcode "mempty"} in {ascii}) or {hcode "(★)"} ({hcode "star"} in {ascii})+ and the second is optional and represents the text to be used in the table of contents.»++ section «List like environment»+ todo "how to put a paritem between items"++ section «Declarations»++ p «In {latex} declarations are side effects. For instance {ltxcode "\\small"}+ changes the current size of text to make it smaller, it is an effect on+ the size. However the scope of declarations can be delimited using braces+ ({"{"} and {"}"}).»++-- "toto " ⊕ "\small" ⊕ " tata"+-- toto ⊕ {\small ⊕ tata} ⊕ tutu++ p «In {hlatex} all declarations are explicitely scoped.+ In other words the effects of declarations do not pass through concatenation+ ({hcode "⊕"}) of {latex} pieces.+ They are represented in {hlatex} with types {hcode "TexDecl"} and+ {hcode "MathDecl"} for the math mode.+ The unsafe injection from declarations to pieces of {latex} is still+ available though.»++ section «Tabulars»+ todo «+ why lists+ format spec+ how put hline+ missing features+ »++ section «Paragraphs»+ todo «why strong paragraph distintinction+ no longer double endline meaning+ don't confuse para and paragraph+ »++ section «Math mode»+ subsection «No plain strings»++++ -- p (math "1" ⊕ "+" ⊕ "2")++ {-+ (&) fct arg = fct ⊕ M.parens arg + f arg = M.f & arg++ f M.x+ M.«1 + f({arg}) + Σ^i_(0..n)»+ -}++ subsection «No plain chars»+ todo "=> (M.a, M.b...), in fact yes as unicode support"+ todo "still low level (sum has only one arg)"+ todo "still the same meaning for ⊕ Ligatures"+ todo "num class"++ section «Verbatim mode»++ subsection «Why not using the {latex} verbatim mode?»++ p «{latex} verbatim mode is a hack. It is a kind of global side-effect that+ changes the meaning of letters to turn off their original meaning and+ produce fixed width characters. In result the verbatim mode interacts badly+ with other fancy environments.»++ p «In {haskell} this task is much simpler, indeed we do have literal strings.+ There is no need to change some existing meaning. We just need a function+ from {hcode "String"} to {hcode "LatexItem"}.»+ subsection «The protect function»+ todo «special characters+ Ligatures+ Work with fixed width fonts»+ todo "verb, M.verb, UTF8..."++ section «Figures»++ section «Bibliography, glossary and index»++ section «Making new commands»+ todo "L.L.Builder.Internal"++ section «Injecting Raw LaTeX»++ section «Pictures»++ section «Size units and pre-defineds dimensions»+ todo "normalisation, symbolic eval, num class"++ section «The LatexM monad»+ subsection «What for?»+ subsection «How hidden is it?»+ todo «+ a monad transformer would allow+ custom initial monad, more state,+ more control...+ »++ section «Using the Writer monad»++ section «Misc»+ subsection «Save bins»++ section «Packages»+ subsection «Automatic tracking»++ subsection «graphics»+ subsection «Listings equivalent»++ subsection «Adding new packages»++-- end
+ hlatex.cabal view
@@ -0,0 +1,54 @@+name: hlatex+cabal-version: >= 1.8+version: 0.1+license: BSD3+license-File: LICENSE+copyright: (c) Nicolas Pouillard+author: Nicolas Pouillard+maintainer: Nicolas Pouillard <nicolas.pouillard@gmail.com>+category: Text+synopsis: A library to build valid LaTeX files+description: ...+stability: Provisional+build-type: Simple++flag build_doc+ Default: False++library+ build-depends:+ base>=3.0&&<5, containers>=0.1, process, filepath, directory,+ template-haskell >= 2.5,+ transformers>=0.2.1&&<1, mtl>2.0, base-unicode-symbols,+ uniplate>=1.4&&<1.7, derive, utf8-string+ exposed-modules:+ Language.LaTeX,+ Language.LaTeX.Types,+ Language.LaTeX.Length,+ Language.LaTeX.Builder,+ Language.LaTeX.Builder.Internal,+ Language.LaTeX.Builder.MonoidUtils,+ Language.LaTeX.Builder.Math,+ Language.LaTeX.Builder.Graphics,+ Language.LaTeX.Builder.Color,+ Language.LaTeX.Builder.Rotating,+ Language.LaTeX.Builder.QQ,+ Language.LaTeX.Builder.Beamer,+ Language.LaTeX.Builder.Babel,+ Language.LaTeX.Printer,+ Language.LaTeX.Slicer,+ Language.LaTeX.Checker,+ Language.LaTeX.Unicode+ ghc-options: -Wall++executable generate_hlatex_user_guide+ Build-depends: base>=3.0, containers>=0.1, frquotes,+ transformers, mtl>2.0, base-unicode-symbols+ main-is: doc/user_guide.hs+ ghc-options: -Wall+ if !flag(build_doc)+ Buildable: False++source-repository head+ type: git+ location: https://github.com/np/hlatex.git