diff --git a/CHANGELOG b/CHANGELOG deleted file mode 100644 --- a/CHANGELOG +++ /dev/null @@ -1,8 +0,0 @@ -Changes (w.r.t. lhs2TeX 1.16) ------------------------------ - -* Cabal-1.10 support - -* Fix for file permissions problem of installed files - -* Several improvements to the documentation diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,8 @@ +* lhs2tex-1.21 + +- Some code refactoring. +- Experimental markdown mode. +- Improved output when using deprecated modes (#59). +- Compatibility with ghc-8.4 (#69). +- Fix in the formatting directives parser (#64). + diff --git a/INSTALL b/INSTALL --- a/INSTALL +++ b/INSTALL @@ -32,7 +32,7 @@ Unpack the archive. Assume that it has been unpacked into directory "/somewhere". Then say -cd /somewhere/lhs2TeX-1.20 +cd /somewhere/lhs2TeX-1.21 ./configure make make install @@ -48,17 +48,18 @@ lhs2TeX binary. The default search path is as follows: . -{HOME}/lhs2tex-1.20// +{HOME}/lhs2tex-1.21// {HOME}/lhs2tex// {HOME}/lhs2TeX// -{HOME}/.lhs2tex-1.20// +{HOME}/.lhs2tex-1.21// {HOME}/.lhs2tex// {HOME}/.lhs2TeX// {LHS2TEX}// -/usr/local/share/lhs2tex-1.20// -/usr/local/lib/lhs2tex-1.20// -/usr/share/lhs2tex-1.20// -/usr/lib/lhs2tex-1.20// +/usr/local/share/lhs2tex-1.21// +/usr/local/share/lhs2tex-1.21// +/usr/local/lib/lhs2tex-1.21// +/usr/share/lhs2tex-1.21// +/usr/lib/lhs2tex-1.21// /usr/local/share/lhs2tex// /usr/local/lib/lhs2tex// /usr/share/lhs2tex// diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -175,7 +175,7 @@ $(INSTALL) -m 644 Makefile common.mk config.mk.in $(DISTDIR) $(INSTALL) -m 644 lhs2TeX.1.in $(DISTDIR) $(INSTALL) -m 755 configure mkinstalldirs install-sh $(DISTDIR) - $(INSTALL) -m 644 TODO AUTHORS LICENSE CHANGELOG $(DISTDIR) + $(INSTALL) -m 644 TODO AUTHORS LICENSE CHANGELOG.md $(DISTDIR) cat INSTALL | sed -e "s/@ProgramVersion@/$(PACKAGE_VERSION)/" \ > $(DISTDIR)/INSTALL chmod 644 $(DISTDIR)/INSTALL @@ -205,7 +205,7 @@ $(INSTALL) -m 644 Makefile common.mk config.mk.in $(DISTDIR) $(INSTALL) -m 644 lhs2TeX.1.in $(DISTDIR) $(INSTALL) -m 755 configure mkinstalldirs install-sh $(DISTDIR) - $(INSTALL) -m 644 TODO AUTHORS LICENSE CHANGELOG $(DISTDIR) + $(INSTALL) -m 644 TODO AUTHORS LICENSE CHANGELOG.md $(DISTDIR) cat INSTALL | sed -e "s/@ProgramVersion@/$(PACKAGE_VERSION)/" \ > $(DISTDIR)/INSTALL chmod 644 $(DISTDIR)/INSTALL diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -34,7 +34,7 @@ minPolytableVersion = [0,8,2] shortversion = show (numversion `div` 100) ++ "." ++ show (numversion `mod` 100) version = shortversion ++ if ispre then "pre" ++ show pre else "" -numversion = 120 +numversion = 121 ispre = False pre = 1 diff --git a/configure b/configure --- a/configure +++ b/configure @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.69 for lhs2tex 1.20. +# Generated by GNU Autoconf 2.69 for lhs2tex 1.21. # # # Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. @@ -576,8 +576,8 @@ # Identity of this package. PACKAGE_NAME='lhs2tex' PACKAGE_TARNAME='lhs2tex' -PACKAGE_VERSION='1.20' -PACKAGE_STRING='lhs2tex 1.20' +PACKAGE_VERSION='1.21' +PACKAGE_STRING='lhs2tex 1.21' PACKAGE_BUGREPORT='' PACKAGE_URL='' @@ -1203,7 +1203,7 @@ # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures lhs2tex 1.20 to adapt to many kinds of systems. +\`configure' configures lhs2tex 1.21 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1264,7 +1264,7 @@ if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of lhs2tex 1.20:";; + short | recursive ) echo "Configuration of lhs2tex 1.21:";; esac cat <<\_ACEOF @@ -1342,7 +1342,7 @@ test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -lhs2tex configure 1.20 +lhs2tex configure 1.21 generated by GNU Autoconf 2.69 Copyright (C) 2012 Free Software Foundation, Inc. @@ -1359,7 +1359,7 @@ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by lhs2tex $as_me 1.20, which was +It was created by lhs2tex $as_me 1.21, which was generated by GNU Autoconf 2.69. Invocation command line was $ $0 $@ @@ -1708,9 +1708,9 @@ -VERSION="1.20" -SHORTVERSION="1.20" -NUMVERSION=120 +VERSION="1.21" +SHORTVERSION="1.21" +NUMVERSION=121 PRE=1 @@ -3347,7 +3347,7 @@ # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by lhs2tex $as_me 1.20, which was +This file was extended by lhs2tex $as_me 1.21, which was generated by GNU Autoconf 2.69. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -3400,7 +3400,7 @@ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ -lhs2tex config.status 1.20 +lhs2tex config.status 1.21 configured by $0, generated by GNU Autoconf 2.69, with options \\"\$ac_cs_config\\" diff --git a/doc/Guide2.lhs b/doc/Guide2.lhs --- a/doc/Guide2.lhs +++ b/doc/Guide2.lhs @@ -954,7 +954,7 @@ \end{colorsurround} % In the first line there are no parentheses to drop. In the second -line, the parentheses around the arguments @a@ and @b@ are dropped, as +line, the parentheses around the arguments @a@ and @c@ are dropped, as are the parentheses around the function @ptest@. In the third line, the source has double parentheses around each argument as well as the function. One set of parentheses are dropped in each case, except for diff --git a/doc/Guide2.pdf b/doc/Guide2.pdf Binary files a/doc/Guide2.pdf and b/doc/Guide2.pdf differ diff --git a/doc/Implicit.lhs b/doc/Implicit.lhs --- a/doc/Implicit.lhs +++ b/doc/Implicit.lhs @@ -7,4 +7,4 @@ %format omega' |[omega, omega13, omega', omega13']|\par %format omega13' -|[omega, omega13, omega13']| +|[omega, omega13, omega', omega13']| diff --git a/doc/RawSearchPath.lhs b/doc/RawSearchPath.lhs --- a/doc/RawSearchPath.lhs +++ b/doc/RawSearchPath.lhs @@ -1,16 +1,17 @@ \begin{code} . -{HOME}/lhs2tex-1.20// +{HOME}/lhs2tex-1.21// {HOME}/lhs2tex// {HOME}/lhs2TeX// -{HOME}/.lhs2tex-1.20// +{HOME}/.lhs2tex-1.21// {HOME}/.lhs2tex// {HOME}/.lhs2TeX// {LHS2TEX}// -/usr/local/share/lhs2tex-1.20// -/usr/local/lib/lhs2tex-1.20// -/usr/share/lhs2tex-1.20// -/usr/lib/lhs2tex-1.20// +/usr/local/share/lhs2tex-1.21// +/usr/local/share/lhs2tex-1.21// +/usr/local/lib/lhs2tex-1.21// +/usr/share/lhs2tex-1.21// +/usr/lib/lhs2tex-1.21// /usr/local/share/lhs2tex// /usr/local/lib/lhs2tex// /usr/share/lhs2tex// diff --git a/lhs2TeX.fmt.lit b/lhs2TeX.fmt.lit --- a/lhs2TeX.fmt.lit +++ b/lhs2TeX.fmt.lit @@ -207,7 +207,7 @@ %-------------------------------= -------------------------------------------- \begin{code} -%elif style == newcode +%elif (style == newcode) || (style == markdown) %subst comment a = "-- " a %subst nested a = "{- " a " -}" %subst code a = a "'n" @@ -227,6 +227,10 @@ %subst backquoted a = "`" a "`" %subst char a = "''" a "''" %subst string a = "'d" a "'d" +%if style == markdown +%subst inline a = "`" a "`" +%subst code a = "```'n" a "'n```'n" +%endif \end{code} %-------------------------------= -------------------------------------------- diff --git a/lhs2TeX.sty.lit b/lhs2TeX.sty.lit --- a/lhs2TeX.sty.lit +++ b/lhs2TeX.sty.lit @@ -10,7 +10,7 @@ %let lhs2tex_lhs2tex_sty_read = True %include lhs2TeX.fmt % -%if style /= newcode +%if (style /= newcode) && (style /= markdown) % \makeatletter \@@ifundefined{lhs2tex.lhs2tex.sty.read}% diff --git a/lhs2tex.cabal b/lhs2tex.cabal --- a/lhs2tex.cabal +++ b/lhs2tex.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: lhs2tex -version: 1.20 +version: 1.21 license: GPL license-file: LICENSE author: Ralf Hinze , Andres Loeh @@ -26,10 +26,11 @@ build-type: Custom tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.1 extra-source-files: AUTHORS - CHANGELOG + CHANGELOG.md INSTALL TODO doc/*.lhs + doc/*.lhs.in doc/*.fmt doc/Guide2.lhs doc/Guide2.pdf @@ -73,13 +74,14 @@ main-is: Main.lhs hs-source-dirs: src default-language: Haskell98 + ghc-options: -Wall other-extensions: ScopedTypeVariables NPlusKPatterns GeneralizedNewtypeDeriving TypeSynonymInstances build-depends: base >= 4.2 && < 5, regex-compat, - mtl, + mtl >= 2.2.1, filepath, directory, process diff --git a/src/Auxiliaries.lhs b/src/Auxiliaries.lhs --- a/src/Auxiliaries.lhs +++ b/src/Auxiliaries.lhs @@ -4,16 +4,12 @@ %if codeOnly || showModuleHeader -> {-# LANGUAGE TypeSynonymInstances #-} -> {-# LANGUAGE FlexibleInstances #-} > module Auxiliaries ( module Auxiliaries ) > where > > import Data.Char ( isSpace ) > import Control.Arrow ( (>>>), Kleisli(..) ) > import qualified Control.Arrow as A -> import Control.Monad ( MonadPlus(..) ) -> import Control.Monad.Error %endif @@ -45,7 +41,7 @@ > merge :: (Ord a) => [a] -> [a] -> [a] > merge [] bs = bs -> merge as@(a : _) [] = as +> merge as@(_a : _) [] = as > merge as@(a : as') bs@(b : bs') > | a <= b = a : merge as' bs > | otherwise = b : merge as bs' @@ -58,20 +54,20 @@ %} > breakAfter :: (a -> Bool) -> [a] -> ([a], [a]) -> breakAfter p [] = ([], []) -> breakAfter p (a : as) +> breakAfter _p [] = ([], []) +> breakAfter p (a : as) > | p a = ([a], as) > | otherwise = a <| breakAfter p as > breaks :: ([a] -> Bool) -> [a] -> ([a], [a]) -> breaks p [] = ([], []) -> breaks p as@(a : as') +> breaks _p [] = ([], []) +> breaks p as@(a : as') > | p as = ([], as) > | otherwise = a <| breaks p as' > -- isPrefix :: (Eq a) => [a] -> [a] -> Bool > -- p `isPrefix` as = p == take (length p) as - + > withoutSpaces :: String -> String > withoutSpaces s = filter (not . isSpace) s @@ -79,7 +75,7 @@ > group n = repSplit (repeat n) >>> takeWhile (not . null) > repSplit :: [Int] -> [a] -> [[a]] -> repSplit [] xs = [] +> repSplit [] _xs = [] > repSplit (n : ns) xs = ys : repSplit ns zs > where (ys, zs) = splitAt n xs @@ -107,10 +103,6 @@ > type Message = String > type Exc = (Message, String) -> instance Error Exc where -> noMsg = ("unknown error", "") -> strMsg s = (s, "") - Reverse Composition. > (<|) :: a -> ([a], b) -> ([a], b) @@ -120,13 +112,3 @@ > impossible name = error ("The `impossible' happened in \"" > ++ name ++ "\"") -% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - -\subsubsection{Obsolete code} -% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - - -> command :: String -> String -> String -> command name arg = "\\" ++ name ++ "{" ++ arg ++ "}" -> -> environment :: String -> String -> String -> environment name m = "\\begin{" ++ name ++ "}" ++ m -> ++ "\\end{" ++ name ++ "}" diff --git a/src/Directives.lhs b/src/Directives.lhs --- a/src/Directives.lhs +++ b/src/Directives.lhs @@ -7,13 +7,11 @@ > module Directives ( Formats, parseFormat, Equation, Substs, Subst, parseSubst, Toggles, eval, define, value, nrargs ) > where > -> import Control.Applicative ( many, optional ) -> import Control.Monad -> import Data.Char ( isSpace, isAlpha, isDigit ) +> import Control.Applicative +> import Data.Char ( isDigit ) > import Data.List > import Parser > import TeXCommands -> import TeXParser > import HsLexer > import FiniteMap ( FiniteMap, (!) ) > import qualified FiniteMap as FM @@ -51,17 +49,20 @@ Format directives. \NB @%format ( = "(\;"@ is legal. > equation :: Lang -> Parser Token (String, Equation) -> equation lang = do (opt, (f, opts, args)) <- optParen lhs -> _ <- varsym lang "=" -> r <- many item -> return (f, (opt, opts, args, r)) -> `mplus` do f <- item -> _ <- varsym lang "=" -> r <- many item -> return (string f, (False, [], [], r)) +> equation lang = do (opt, (f, opts, args)) <- optParen lhs +> _ <- varsym lang "=" +> r <- many item +> eof +> return (f, (opt, opts, args, r)) +> <|> do f <- item +> _ <- varsym lang "=" +> r <- many item +> eof +> return (string f, (False, [], [], r)) > -- no RHS, try implicit formatting rules -> `mplus` do f <- satisfy isVarid `mplus` satisfy isConid -> return (string f, (False, [], [], tex f)) +> <|> do f <- satisfy isVarid <|> satisfy isConid +> eof +> return (string f, (False, [], [], tex f)) \Todo{@%format `div1`@ funktioniert nicht.} @@ -73,15 +74,16 @@ > tex (Conid s) = subscript Conid s > tex (Qual [] s) = tex s > tex (Qual (m:ms) s) = Conid m : tex (Qual ms s) -> -- ks, 03.09.2003: was "tex (Qual m s) = Conid m : tex s"; +> -- ks, 03.09.2003: was "tex (Qual m s) = Conid m : tex s"; > -- seems strange though ... -> subscript f s +> tex _ = impossible "equation.tex" +> subscript f s > | null t && not (null w) && (null v || head w == '_') > = underscore f s > | otherwise = [f (reverse w) > , TeX False > (Text ((if not (null v) -> then "_{" ++ reverse v ++ "}" +> then "_{" ++ reverse v ++ "}" > else "" > ) ++ reverse t)) > ] @@ -97,7 +99,7 @@ > (if end then [Varid "_"] else []) ks, 02.02.2004: I have added implicit formatting via |underscore|. -The above condition should guarantee that it is (almost) only used in +The above condition should guarantee that it is (almost) only used in cases where previously implicit formatting did not do anything useful. The function |underscore| typesets an identifier such as |a_b_c| as $a_{b_{c}}$. TODO: Instead of hard-coded subscripting a @@ -114,26 +116,29 @@ > where (t, u) = break (== '_') s > tok_u = tokenize lang (tail u) > proc_u = case tok_u of -> Left _ -> [f (tail u)] -- should not happen -> Right t -> t +> Left _ -> [f (tail u)] -- should not happen +> Right t' -> t' > lhs :: Parser Token (String, [Bool], [String]) -> lhs = do f <- varid `mplus` conid +> lhs = do f <- varid <|> conid > as <- many (optParen varid) > let (opts, args) = unzip as > return (f, opts, args) > optParen :: Parser Token a -> Parser Token (Bool, a) -> optParen p = do _ <- open'; a <- p; _ <- close'; return (True, a) -> `mplus` do a <- p ; return (False, a) +> optParen p = do _ <- open'; a <- p; _ <- close'; return (True, a) +> <|> do a <- p ; return (False, a) > +> item :: Parser Token Token > item = satisfy (const True) +> convert :: String -> String > convert [] = [] > convert ('"' : '"' : s) = '"' : convert s > convert ('"' : s) = '{' : '-' : '"' : convert' s > convert (c : s) = c : convert s > +> convert' :: String -> String > convert' [] = [] > convert' ('"' : '"' : s) = '"' : convert' s > convert' ('"' : s) = '"' : '-' : '}' : convert s @@ -153,13 +158,14 @@ > substitution lang = do s <- varid > args <- many varid > _ <- varsym lang "=" -> rhs <- many (satisfy isVarid `mplus` satisfy isTeX) +> rhs <- many (satisfy isVarid <|> satisfy isTeX) > return (s, subst args rhs) > where > subst :: [String] -> [Token] -> Subst > subst args rhs ds = catenate (map sub rhs) > where sub (TeX _ d) = d > sub (Varid x) = FM.fromList (zip args ds) ! x +> sub _ = impossible "substitution.subst.sub" > -- TODO: The above lookup can fail badly if unknown variables are used on the rhs of a subst. \Todo{unbound variables behandeln.} @@ -168,11 +174,17 @@ lexer, "=" is both a varid and a varsym. This shouldn't matter for Haskell, because "=" will never occur in a Varid constructor. +> varid :: Parser Token String > varid = do x <- satisfy (\ x -> isVarid x && x /= Varid "="); return (string x) + +> conid :: Parser Token String > conid = do x <- satisfy isConid; return (string x) + +> varsym :: Lang -> String -> Parser Token Token > varsym Agda s = satisfy (\ x -> x == Varsym s || x == Varid s) -- Agda has no symbol/id distinction > varsym Haskell s = satisfy (== (Varsym s)) > +> isTeX :: Token -> Bool > isTeX (TeX _ _) = True > isTeX _ = False @@ -192,17 +204,18 @@ > where > expr = do e1 <- appl > e2 <- optional (do op <- varsym' lang; e <- expr; return (op, e)) -> return (maybe e1 (\(op, e2) -> sys2 op e1 e2) e2) +> return (maybe e1 (\(op, e2') -> sys2 op e1 e2') e2) > appl = do f <- optional not' > e <- atom > return (maybe e (\_ -> onBool1 not e) f) -> atom = do Varid x <- satisfy isVarid; return (value togs x) -> `mplus` do _ <- true'; return (Bool True) -> `mplus` do _ <- false'; return (Bool False) -> `mplus` do s <- satisfy isString; return (Str (read (string s))) -> `mplus` do s <- satisfy isNumeral; return (Int (read (string s))) -> `mplus` do _ <- open'; e <- expr; _ <- close'; return e +> atom = do Varid x <- satisfy isVarid; return (value togs x) +> <|> do _ <- true'; return (Bool True) +> <|> do _ <- false'; return (Bool False) +> <|> do s <- satisfy isString; return (Str (read (string s))) +> <|> do s <- satisfy isNumeral; return (Int (read (string s))) +> <|> do _ <- open'; e <- expr; _ <- close'; return e > +> sys2 :: String -> Binary Value > sys2 "&&" = onBool2 (&&) > sys2 "||" = onBool2 (||) > sys2 "==" = onMatching (==) (==) (==) @@ -241,23 +254,30 @@ > open' = satisfy (== (Special '(')) > close' = satisfy (== (Special ')')) +> varsym' :: Lang -> Parser Token String > varsym' lang = do x <- satisfy (isVarsym lang); return (string x) + +> isVarsym :: Lang -> Token -> Bool > isVarsym _ (Varsym _) = True > isVarsym Agda (Varid _) = True -- for Agda > isVarsym _ _ = False + +> isString :: Token -> Bool > isString (String _) = True > isString _ = False + +> isNumeral :: Token -> Bool > isNumeral (Numeral _) = True > isNumeral _ = False Hilfsfunktionen. > parse :: Lang -> Parser Token a -> String -> Either Exc a -> parse lang p str = do ts <- tokenize lang str +> parse lang p str' = do ts <- tokenize lang str' > let ts' = map (\t -> case t of TeX _ x -> TeX False x; _ -> t) . > filter (\t -> catCode t /= White || isTeX t) $ ts > maybe (Left msg) Right (run p ts') -> where msg = ("syntax error in directive", str) +> where msg = ("syntax error in directive", str') Hack: |isTeX t| f"ur |parseSubst|. diff --git a/src/Document.lhs b/src/Document.lhs --- a/src/Document.lhs +++ b/src/Document.lhs @@ -6,10 +6,11 @@ > module Document ( module Document ) > where +> %endif -> infixr 5 {-"\enskip"-} <> -- same fixity as `|++|' +> infixr 5 {-"\enskip"-} <<>> -- same fixity as `|++|' The pretty printer generate documents of type |Doc|. @@ -23,54 +24,89 @@ |Embedded| is used for embedded pseudo \TeX\ text (eg in comments); |Sub s ds| is used for replacements (eg |Sub "inline" [..]|). -> (<>) :: Doc -> Doc -> Doc -> Empty <> d = d -> d <> Empty = d -> d1 <> d2 = d1 :^: d2 +> (<<>>) :: Doc -> Doc -> Doc +> Empty <<>> d = d +> d <<>> Empty = d +> d1 <<>> d2 = d1 :^: d2 > > catenate :: [Doc] -> Doc -> catenate = foldr (<>) Empty +> catenate = foldr (<<>>) Empty Substitution strings. +> sub'thin :: Doc > sub'thin = Sub "thinspace" [] +> sub'space :: Doc > sub'space = Sub "space" [] +> sub'nl :: Doc > sub'nl = Sub "newline" [] +> sub'verbnl :: Doc > sub'verbnl = Sub "verbnl" [] +> sub'blankline :: Doc > sub'blankline = Sub "blankline" [] +> sub'dummy :: Doc > sub'dummy = Sub "dummy" [] > +> sub'spaces :: Doc -> Doc > sub'spaces a = Sub "spaces" [a] +> sub'special :: Doc -> Doc > sub'special a = Sub "special" [a] +> sub'verb :: Doc -> Doc > sub'verb a = Sub "verb" [a] +> sub'verbatim :: Doc -> Doc > sub'verbatim a = Sub "verbatim" [a] +> sub'inline :: Doc -> Doc > sub'inline a = Sub "inline" [a] +> sub'code :: Doc -> Doc > sub'code a = Sub "code" [a] +> sub'conid :: Doc -> Doc > sub'conid a = Sub "conid" [a] +> sub'varid :: Doc -> Doc > sub'varid a = Sub "varid" [a] +> sub'consym :: Doc -> Doc > sub'consym a = Sub "consym" [a] +> sub'varsym :: Doc -> Doc > sub'varsym a = Sub "varsym" [a] +> sub'backquoted :: Doc -> Doc > sub'backquoted a = Sub "backquoted" [a] +> sub'numeral :: Doc -> Doc > sub'numeral a = Sub "numeral" [a] +> sub'char :: Doc -> Doc > sub'char a = Sub "char" [a] +> sub'string :: Doc -> Doc > sub'string a = Sub "string" [a] +> sub'comment :: Doc -> Doc > sub'comment a = Sub "comment" [a] +> sub'nested :: Doc -> Doc > sub'nested a = Sub "nested" [a] +> sub'pragma :: Doc -> Doc > sub'pragma a = Sub "pragma" [a] +> sub'tex :: Doc -> Doc > sub'tex a = Sub "tex" [a] +> sub'keyword :: Doc -> Doc > sub'keyword a = Sub "keyword" [a] +> sub'column1 :: Doc -> Doc > sub'column1 a = Sub "column1" [a] +> sub'hskip :: Doc -> Doc > sub'hskip a = Sub "hskip" [a] +> sub'phantom :: Doc -> Doc > sub'phantom a = Sub "phantom" [a] > +> sub'column3 :: Doc -> Doc -> Doc -> Doc > sub'column3 a1 a2 a3 = Sub "column3" [a1, a2, a3] Additional substitutions for the new @poly@ formatter. Added by ks, 14.05.2003. +> sub'fromto :: String -> String -> Doc -> Doc > sub'fromto b e a = Sub "fromto" [Text b,Text e,a] +> sub'column :: String -> Doc -> Doc > sub'column n a = Sub "column" [Text n,a] +> sub'centered :: Doc > sub'centered = Sub "centered" [] +> sub'left :: Doc > sub'left = Sub "left" [] +> sub'dummycol :: Doc > sub'dummycol = Sub "dummycol" [] +> sub'indent :: Doc -> Doc > sub'indent n = Sub "indent" [n] diff --git a/src/FileNameUtils.lhs b/src/FileNameUtils.lhs --- a/src/FileNameUtils.lhs +++ b/src/FileNameUtils.lhs @@ -41,6 +41,7 @@ > -- absPath ps = directorySeparator : relPath ps +> isWindows :: Bool > isWindows = "win" `isPrefixOf` os || "Win" `isPrefixOf` os || "mingw" `isPrefixOf` os > absPath :: FilePath -> FilePath @@ -80,7 +81,7 @@ > (sep,rs') = span isPathSeparator rs > s' = reverse rs' > sep' = reverse sep -> in if null s' +> in if null s' > then return [[head sep']] {- we don't descend from root -} > else if length sep < 2 > then return [s] @@ -99,10 +100,12 @@ > expandEnvironment :: String -> IO [String] > expandEnvironment s = case break (=='{') s of -> (s',"") -> return [s] +> (_s',"") -> return [s] > (s','{':r) -> case break (=='}') r of -> (e,"") -> return [s] +> (_e,"") -> return [s] > (e,'}':r') -> findEnvironment e s' r' +> _ -> impossible "expandEnvironment" +> _ -> impossible "expandEnvironment" > where findEnvironment :: String -> String -> String -> IO [String] > findEnvironment e a o = do er <- try (getEnv e) > return $ either (\ (_ :: IOException) -> []) diff --git a/src/FiniteMap.lhs b/src/FiniteMap.lhs --- a/src/FiniteMap.lhs +++ b/src/FiniteMap.lhs @@ -32,12 +32,12 @@ > lookup x (Leaf y w) > | x == y = Just w > | otherwise = Nothing -> lookup [] (Node ts w) = w -> lookup (a : x) (Node ts w) = lookupList ts +> lookup [] (Node _ts w) = w +> lookup (a : x) (Node ts _w) = lookupList ts > where > lookupList [] = Nothing -> lookupList ((b, t) : ts) = case compare b a of -> LT -> lookupList ts +> lookupList ((b, t) : ts') = case compare b a of +> LT -> lookupList ts' > EQ -> lookup x t > GT -> Nothing @@ -65,13 +65,13 @@ > LT -> Node [(b, Leaf y w), (a, Leaf x v)] Nothing > EQ -> Node [(a, insert (Leaf y w) x v)] Nothing > GT -> Node [(a, Leaf x v), (b, Leaf y w)] Nothing -> insert (Node ts w) [] v = Node ts (Just v) -> insert (Node ts w) (a : x) v = Node (insList ts) w +> insert (Node ts _w) [] v = Node ts (Just v) +> insert (Node ts w) (a : x) v = Node (insList ts) w > where > insList [] = [(a,Leaf x v)] -> insList ((b, t) : ts) = case compare b a of -> LT -> (b, t) : insList ts -> EQ -> (b, insert t x v) : ts -> GT -> (a, Leaf x v) : (b, t) : ts +> insList ((b, t) : ts') = case compare b a of +> LT -> (b, t) : insList ts' +> EQ -> (b, insert t x v) : ts' +> GT -> (a, Leaf x v) : (b, t) : ts' %} diff --git a/src/HsLexer.lhs b/src/HsLexer.lhs --- a/src/HsLexer.lhs +++ b/src/HsLexer.lhs @@ -9,8 +9,8 @@ > where > import Data.Char ( isSpace, isUpper, isLower, isDigit, isAlphaNum, isPunctuation ) > import qualified Data.Char ( isSymbol ) +> import Control.Applicative > import Control.Monad -> import Control.Monad.Error () > import Document > import Auxiliaries > import TeXCommands ( Lang(..) ) @@ -91,38 +91,39 @@ ks, 28.08.2008: New: Agda and Haskell modes. > lexify :: Lang -> [Char] -> Either Exc [Token] -> lexify lang [] = return [] -> lexify lang s@(_ : _) = case lex' lang s of +> lexify _lang [] = return [] +> lexify lang s@(_ : _) = case lex' lang s of > Nothing -> Left ("lexical error", s) > Just (t, s') -> do ts <- lexify lang s'; return (t : ts) > > lex' :: Lang -> String -> Maybe (Token, String) -> lex' lang "" = Nothing -> lex' lang ('\'' : s) = do let (t, u) = lexLitChar s +> lex' _lang "" = Nothing +> lex' _lang ('\'' : s) = do let (t, u) = lexLitChar s > v <- match "\'" u > return (Char ("'" ++ t ++ "'"), v) -> lex' lang ('"' : s) = do let (t, u) = lexLitStr s +> lex' _lang ('"' : s) = do let (t, u) = lexLitStr s > v <- match "\"" u > return (String ("\"" ++ t ++ "\""), v) -> lex' lang ('-' : '-' : s) +> lex' lang ('-' : '-' : s) > | not (null s') && isSymbol lang (head s') > = case s' of > (c : s'') -> return (varsymid lang ("--" ++ d ++ [c]), s'') +> [] -> impossible "lex'" > | otherwise = return (Comment t, u) > where (d, s') = span (== '-') s > (t, u) = break (== '\n') s' -> lex' lang ('{' : '-' : '"' : s) +> lex' _lang ('{' : '-' : '"' : s) > = do let (t, u) = inlineTeX s > v <- match "\"-}" u > return (TeX True (Text t), v) -> lex' lang ('{' : '-' : '#' : s) +> lex' _lang ('{' : '-' : '#' : s) > = do let (t, u) = nested 0 s > v <- match "#-}" u > return (Pragma t, v) -> lex' lang ('{' : '-' : s) = do let (t, u) = nested 0 s +> lex' _lang ('{' : '-' : s) = do let (t, u) = nested 0 s > v <- match "-}" u > return (Nested t, v) -> lex' lang (c : s) +> lex' lang (c : s) > | isSpace c = let (t, u) = span isSpace s in return (Space (c : t), u) > | isSpecial lang c = Just (Special c, s) > | isUpper c = let (t, u) = span (isIdChar lang) s in return (Conid (c : t), u) @@ -136,34 +137,37 @@ > where > numeral Agda = Varid > numeral Haskell = Numeral -> classify s -> | s `elem` keywords lang -> = Keyword s -> | otherwise = Varid s +> classify s' +> | s' `elem` keywords lang +> = Keyword s' +> | otherwise = Varid s' > > > lexFracExp :: String -> Maybe (String, String) -> lexFracExp s = do t <- match "." s -> (ds, u) <- lexDigits' t -> (e, v) <- lexExp u -> return ('.' : ds ++ e, v) -> `mplus` lexExp s +> lexFracExp s = do t <- match "." s +> (ds, u) <- lexDigits' t +> (e, v) <- lexExp u +> return ('.' : ds ++ e, v) +> <|> lexExp s > > lexExp :: String -> Maybe (String, String) > lexExp (e:s) -> | e `elem` "eE" = do (c : t) <- Just s -> unless (c `elem` "+-") Nothing -> (ds, u) <- lexDigits' t -> return (e : c : ds, u) -> `mplus` do (ds, t) <- lexDigits' s -> return (e : ds, t) +> | e `elem` "eE" = do (c : t) <- Just s +> unless (c `elem` "+-") Nothing +> (ds, u) <- lexDigits' t +> return (e : c : ds, u) +> <|> do (ds, t) <- lexDigits' s +> return (e : ds, t) > lexExp s = Just ("", s) > > lexDigits' :: String -> Maybe (String, String) > lexDigits' s = do (cs@(_ : _), t) <- Just (span isDigit s); return (cs, t) +> varsymid :: Lang -> String -> Token > varsymid Agda = Varid > varsymid Haskell = Varsym +> +> consymid :: Lang -> String -> Token > consymid Agda = Conid > consymid Haskell = Consym diff --git a/src/Main.lhs b/src/Main.lhs --- a/src/Main.lhs +++ b/src/Main.lhs @@ -18,12 +18,11 @@ > import System.Process > import Control.Arrow > import Control.Monad -> import Control.Monad.Error +> import Control.Monad.Except > import Control.Monad.State ( MonadState(..), modify ) -> import Control.Monad.Trans -> import Prelude hiding ( getContents ) +> import Prelude hiding ( getContents, pi ) > -> import Version +> import qualified Version as V > import TeXCommands > import TeXParser > import qualified Verbatim @@ -37,7 +36,7 @@ > import StateT > import qualified FiniteMap as FM > import Auxiliaries -> import Value +> import Value hiding ( str ) > import License > > import FileNameUtils @@ -65,7 +64,7 @@ > [] -> lhs2TeX Poly flags (reverse initdirs) n > -- ks, 22.11.2005, changed default style to |Poly| > [Help] -> quitSuccess (usageInfo uheader options) -> [SearchPath] -> quitSuccess (init . unlines $ searchPath) +> [SearchPath] -> quitSuccess (init . unlines $ V.searchPath) > [Version] -> quitSuccess programInfo > [Copying] -> quitSuccess (programInfo ++ "\n\n" ++ copying) > [Warranty] -> quitSuccess (programInfo ++ "\n\n" ++ warranty) @@ -96,11 +95,11 @@ > } > where toggles0 = --[(decode CodeOnly, Bool (sty == CodeOnly))] > [("style", Int (fromEnum sty))] -> ++ [("version", Int numversion)] -> ++ [("pre", Int pre)] +> ++ [("version", Int V.numversion)] +> ++ [("pre", Int V.pre)] > ++ [("lang", Int (fromEnum (lang s)))] -> ++ [ (decode s, Int (fromEnum s)) | s <- [(minBound :: Style) .. maxBound] ] -> ++ [ (decode s, Int (fromEnum s)) | s <- [(minBound :: Lang) .. maxBound] ] +> ++ [ (decode s', Int (fromEnum s')) | s' <- [(minBound :: Style) .. maxBound] ] +> ++ [ (decode s', Int (fromEnum s')) | s' <- [(minBound :: Lang) .. maxBound] ] > -- |++ [ (s, Bool False) || s <- ["underlineKeywords", "spacePreserving", "meta", "array", "latex209", "times", "euler" ] ]| > preprocess :: State -> [Class] -> Bool -> [String] -> IO () @@ -121,9 +120,9 @@ > preprocess _ _ _ _ = error "preprocess: too few arguments" > lhs2TeX :: Style -> State -> [Class] -> [String] -> IO () -> lhs2TeX s flags dirs files = do (str, file) <- input files +> lhs2TeX s flags dirs files' = do (str, file') <- input files' > expandedpath <- expandPath (searchpath flags) -> toIO (do put (initState s file expandedpath flags) +> toIO (do put (initState s file' expandedpath flags) > formats (map (No 0) dirs) `catchError` abort > formatStr (addEndEOF str) > stopexternals) @@ -143,7 +142,7 @@ @-align@ would not trigger compatibility mode, but be interpreted as a valid option usage. -ks, 24.03.2004: The long option @--verbose@ has been removed for now, +ks, 24.03.2004: The long option @--verbose@ has been removed for now, because with some versions of GHC it triggers ambiguity errors with @--verb@. @@ -153,12 +152,13 @@ > , Option ['v'] [] {- ["verbose"] -} > (NoArg (\s -> return $ s { verbose = True }, id, [])) "be verbose" > , Option ['V'] ["version"] (NoArg (return, id, [Version])) "show version" -> , Option [] ["tt"] (NoArg (return, id, [Typewriter])) "typewriter style" -> , Option [] ["math"] (NoArg (return, id, [Math])) "math style" +> , Option [] ["tt"] (NoArg (return, id, [Typewriter])) "typewriter style (deprecated)" +> , Option [] ["math"] (NoArg (return, id, [Math])) "math style (deprecated)" > , Option [] ["poly"] (NoArg (return, id, [Poly])) "poly style (default)" -> , Option [] ["code"] (NoArg (return, id, [CodeOnly])) "code style" +> , Option [] ["markdown"](NoArg (return, id, [Markdown])) "markdown style" +> , Option [] ["code"] (NoArg (return, id, [CodeOnly])) "code style (deprecated)" > , Option [] ["newcode"] (NoArg (return, id, [NewCode])) "new code style" -> , Option [] ["verb"] (NoArg (return, id, [Verb])) "verbatim" +> , Option [] ["verb"] (NoArg (return, id, [Verb])) "verbatim (deprecated)" > , Option [] ["haskell"] (NoArg (\s -> return $ s { lang = Haskell}, id, [])) "Haskell lexer (default)" > , Option [] ["agda"] (NoArg (\s -> return $ s { lang = Agda}, id, [])) "Agda lexer" > , Option [] ["pre"] (NoArg (return, id, [Pre])) "act as ghc preprocessor" @@ -193,18 +193,18 @@ > cstyle args = cstyle' Typewriter args > cstyle' :: Style -> [String] -> IO () -> cstyle' s args = let (dirs,files) = coptions args -> in lhs2TeX s state0 dirs files +> cstyle' s args = let (dirs,files') = coptions args +> in lhs2TeX s state0 dirs files' > coptions :: [String] -> ([Class], [String]) -> coptions = foldr (<|) ([], []) +> coptions = foldr (<<|) ([], []) > where -> "-align" <| (ds, s : as) = (Directive Align s : ds, as) -> "-i" <| (ds, s : as) = (Directive Include s : ds, as) -> "-l" <| (ds, s : as) = (Directive Let s : ds, as) -> ('-' : 'i' : s) <| (ds, as) = (Directive Include s : ds, as) -> ('-' : 'l' : s) <| (ds, as) = (Directive Let s : ds, as) -> s <| (ds, as) = (ds, s : as) +> "-align" <<| (ds, s : as) = (Directive Align s : ds, as) +> "-i" <<| (ds, s : as) = (Directive Include s : ds, as) +> "-l" <<| (ds, s : as) = (Directive Let s : ds, as) +> ('-' : 'i' : s) <<| (ds, as)= (Directive Include s : ds, as) +> ('-' : 'l' : s) <<| (ds, as)= (Directive Let s : ds, as) +> s <<| (ds, as) = (ds, s : as) We abort immediately if an error has occured. @@ -248,8 +248,8 @@ > format (Command Perform s) = do st <- get > unless (style st `elem` [CodeOnly,NewCode]) $ > do result <- external (map unNL s) -> modify (\st@State{file = f', lineno = l'} -> -> st{file = "", files = (f', l') : files st}) +> modify (\st'@State{file = f', lineno = l'} -> +> st'{file = "", files = (f', l') : files st'}) > liftIO (when (verbose st) (hPutStr stderr $ "(" ++ "")) > formatStr (addEndNL result) > modify (\st'@State{files = (f, l) : fs} -> @@ -258,14 +258,6 @@ > where > addEndNL = (++"\n") . unlines . lines -Remove trailing blank line. - -> trim = reverse >>> skip >>> reverse -> -> skip s | all isSpace t = u -> | otherwise = s -> where (t, u) = breakAfter (== '\n') s - > format (Environment Haskell_ s) > = display s > format (Environment Code s) = display s @@ -277,12 +269,12 @@ > unless (style st `elem` [CodeOnly,NewCode]) $ > do result <- external s > display result -> format (Environment Hide s) = return () -> format (Environment Ignore s) = return () +> format (Environment Hide _s) = return () +> format (Environment Ignore _s)= return () > format (Environment (Verbatim b) s) > = out (Verbatim.display 120 b s) > format (Directive Format s) = do st <- get -> b@(n,e) <- fromEither (parseFormat (lang st) s) +> b@(_n,_e) <- fromEither (parseFormat (lang st) s) > put (st{fmts = FM.add b (fmts st)}) > format (Directive Subst s) = do st <- get > b <- fromEither (parseSubst (lang st) s) @@ -290,19 +282,19 @@ > format (Directive Include arg)= do st <- get > let d = path st > let sp = searchpath st -> modify (\st@State{file = f', lineno = l'} -> -> st{file = f, files = (f', l') : files st, path = d ++ dir f}) +> modify (\st'@State{file = f', lineno = l'} -> +> st'{file = arg', files = (f', l') : files st', path = d ++ dir arg'}) > -- |d <- liftIO getCurrentDirectory| > -- |liftIO (setCurrentDirectory (dir f))| -> (str,f) <- liftIO (chaseFile sp (d ++ f)) -> modify (\st -> st { file = f }) +> (str,f) <- liftIO (chaseFile sp (d ++ arg')) +> modify (\st' -> st' { file = f }) > liftIO (when (verbose st) (hPutStr stderr $ "(" ++ f)) > formatStr (addEndNL str) > -- |liftIO (setCurrentDirectory d)| -> modify (\st'@State{files = (f, l) : fs} -> -> st'{file = f, lineno = l, files = fs, path = d}) +> modify (\st'@State{files = (f', l) : fs} -> +> st'{file = f', lineno = l, files = fs, path = d}) > liftIO (when (verbose st) (hPutStrLn stderr $ ")")) -> where f = withoutSpaces arg +> where arg' = withoutSpaces arg > addEndNL = (++"\n") . unlines . lines ks, 25.01.2003: I added the above function at the suggestion of NAD, but @@ -314,9 +306,9 @@ there will not be a single space between the last character of the included file and the first character of the following line. It would be possible to split a TeX control sequence over two different files that way. Seems -strange. So we add a newline, or even two if none has been there before, +strange. So we add a newline, or even two if none has been there before, to make sure that exactly one linebreak ends up in the output, but not -more, as a double newline is interpreted as a \par by TeX, and that might +more, as a double newline is interpreted as a \par by TeX, and that might also not be desired. > format (Directive Begin _) = modify (\st -> st{stack = fmts st : stack st}) @@ -324,8 +316,8 @@ > when (null (stack st)) $ > do liftIO (hPutStrLn stderr $ "unbalanced %} in line " > ++ show (lineno st)) -> modify (\st -> st{stack = [fmts st]}) -> modify (\st@State{stack = d:ds} -> st{fmts = d, stack = ds}) +> modify (\st' -> st'{stack = [fmts st']}) +> modify (\st'@State{stack = d:ds} -> st'{fmts = d, stack = ds}) ks, 11.09.03: added exception handling for unbalanced grouping @@ -340,7 +332,7 @@ \NB @%align@ also resets the left identation stacks. -Also, the @poly@ directives @%separation@ and @%latency@ reset +Also, the @poly@ directives @%separation@ and @%latency@ reset the corresponding indentation stack |pstack|. > format (Directive Separation s ) @@ -348,10 +340,11 @@ > format (Directive Latency s) = modify (\st -> st{latency = read s, pstack = []}) > format (Directive File s) = modify (\st -> st{file = withoutSpaces s}) -> format (Directive Options s) = modify (\st -> st{opts = trim s}) -> where trim = dropWhile isSpace >>> reverse >>> dropWhile isSpace >>> reverse +> format (Directive Options s) = modify (\st -> st{opts = trim' s}) +> where trim' = dropWhile isSpace >>> reverse >>> dropWhile isSpace >>> reverse > format (Error exc) = throwError exc +> format _ = impossible "format" Printing documents. %{ @@ -367,7 +360,7 @@ > put (st { ofile = file st, olineno = lineno st }) > > liftIO (hPutStr (output st) s) -> modify (\st -> st { olineno = olineno st + ls, atnewline = enl (atnewline st)}) +> modify (\st' -> st' { olineno = olineno st' + ls, atnewline = enl (atnewline st')}) > where > checkNLs n ('\n':[]) = (n+1,const True) > checkNLs n (_:[]) = (n,const False) @@ -384,7 +377,7 @@ > > undef :: String -> String > undef s = "`" ++ s ++ "' is not defined;\n\ -> \perhaps you forgot to include \"lhs2TeX.fmt\"?" +> \perhaps you forgot to include \"polycode.fmt\" (or \"lhs2TeX.fmt\")?" %} @@ -402,12 +395,14 @@ > inline s = do st <- get > d <- fromEither (select (style st) st) > eject d -> where select Verb st = Right (Verbatim.inline False s) +> where select Verb _st = Right (Verbatim.inline False s) > select Typewriter st = Typewriter.inline (lang st) (fmts st) s > select Math st = Math.inline (lang st) (fmts st) (isTrue (toggles st) auto) s > select Poly st = Poly.inline (lang st) (fmts st) (isTrue (toggles st) auto) s -> select CodeOnly st = return Empty -> select NewCode st = return Empty -- generate PRAGMA or something? +> select Markdown st = NewCode.inline (lang st) (fmts st) s +> select CodeOnly _st = return Empty +> select NewCode _st = return Empty -- generate PRAGMA or something? +> select _ _ = impossible "inline.select" > display s = do st <- get > (d, st') <- fromEither (select (style st) st) @@ -421,20 +416,25 @@ > return (d, st{pstack = pstack'}) > select NewCode st = do d <- NewCode.display (lang st) (fmts st) s > let p = sub'pragma $ Text ("LINE " ++ show (lineno st + 1) ++ " " ++ show (takeFileName $ file st)) -> return ((if pragmas st then ((p <> sub'nl) <>) else id) d, st) +> return ((if pragmas st then ((p <<>> sub'nl) <<>>) else id) d, st) +> select Markdown st = do d <- NewCode.display (lang st) (fmts st) s +> return (d, st) > select CodeOnly st = return (Text (trim s), st) +> select _ _ = impossible "display.select" +> auto :: String > auto = "autoSpacing" +> isTrue :: Toggles -> String -> Bool > isTrue togs s = bool (value togs s) Delete leading and trailing blank line (only the first!). > trim :: String -> String -> trim = skip >>> reverse >>> skip >>> reverse +> trim = skip' >>> reverse >>> skip' >>> reverse > where -> skip :: String -> String -> skip "" = "" -> skip s | all isSpace t = u +> skip' :: String -> String +> skip' "" = "" +> skip' s | all isSpace t = u > | otherwise = s > where (t, u) = breakAfter (== '\n') s @@ -454,23 +454,23 @@ > directive :: Lang -> Directive -> String > -> (FilePath,LineNo) -> [CondInfo] -> Toggles > -> [Numbered Class] -> Formatter -> directive lang d s (f,l) stack togs ts -> = dir d s stack +> directive lang' d0 s0 (f0,l0) stack' togs ts +> = dir' d0 s0 stack' > where -> dir If s bs = do b <- fromEither (eval lang togs s) -> skipOrFormat ((f, l, bool b, True) : bs) ts -> dir Elif s ((f,l,b2,b1):bs) = do b <- fromEither (eval lang togs s) +> dir' If s bs = do b <- fromEither (eval lang' togs s) +> skipOrFormat ((f0, l0, bool b, True) : bs) ts +> dir' Elif s ((f,l,b2,b1):bs)= do b <- fromEither (eval lang' togs s) > skipOrFormat ((f, l, bool b, not b2 && b1) : bs) ts -> dir Else _ ((f,l,b2,b1):bs) = skipOrFormat ((f, l, not b2 && b1, True) : bs) ts -> dir Endif _ ((f,l,b2,b1):bs)= skipOrFormat bs ts -> dir EOF _ [] = return () -- nothing left to do -> dir EOF s bs = throwError (init $ unlines (map unBalancedIf bs), s) -> dir d s _ = throwError ("spurious %" ++ decode d, s) +> dir' Else _ ((f,l,b2,b1):bs)= skipOrFormat ((f, l, not b2 && b1, True) : bs) ts +> dir' Endif _ ((_f,_l,_b2,_b1):bs)= skipOrFormat bs ts +> dir' EOF _ [] = return () -- nothing left to do +> dir' EOF s bs = throwError (init $ unlines (map unBalancedIf bs), s) +> dir' d s _ = throwError ("spurious %" ++ decode d, s) > skipOrFormat :: [CondInfo] -> [Numbered Class] -> Formatter -> skipOrFormat stack ts = do modify (\st -> st{conds = stack}) -> if andS stack then formats ts -> else skip ts +> skipOrFormat stack' ts = do modify (\st -> st{conds = stack'}) +> if andS stack' then formats ts +> else skip ts > andS :: [CondInfo] -> Bool > andS = all (\(_,_,x,y) -> x && y) @@ -480,9 +480,9 @@ > skip :: [Numbered Class] -> Formatter > skip [] = return () -> skip ts@(No n (Directive d s) : _) +> skip ts@(No _n (Directive d _s) : _) > | conditional d = formats ts -> skip (t : ts) = skip ts +> skip (_t : ts) = skip ts % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - \subsubsection{Active commands} @@ -543,7 +543,7 @@ > hFlush pin > waitForProcess pid) pis -To extract the answer from @ghci@'s or @hugs@' output +To extract the answer from @ghci@'s or @hugs@' output we use a simple technique which should work in most cases: we print the string |magic| before and after the expression we are interested in. We assume that everything diff --git a/src/Math.lhs b/src/Math.lhs --- a/src/Math.lhs +++ b/src/Math.lhs @@ -10,18 +10,16 @@ > import Prelude hiding ( lines ) > import Data.List ( partition ) > import Numeric ( showFFloat ) -> import Control.Applicative ( many ) +> import Control.Applicative > import Control.Arrow ( (>>>) ) -> import Control.Monad ( MonadPlus(..), (>=>) ) +> import Control.Monad ( (>=>) ) > > import Verbatim ( expand, trim ) -> import Typewriter ( latex ) > import MathCommon > import Document > import Directives > import HsLexer > import Parser -> import qualified FiniteMap as FM > import Auxiliaries > import TeXCommands ( Lang(..) ) @@ -76,21 +74,21 @@ > > chunk :: (CToken tok) => Parser (Pos tok) (Chunk (Pos tok)) > chunk = do a <- many atom -> as <- many (do s <- sep; a <- many atom; return (Delim s : offside a)) +> as <- many (do s <- sep; a' <- many atom; return (Delim s : offside a')) > return (offside a ++ concat as) > where offside [] = [] > -- old: |opt a = [Apply a]| > offside (a : as) = Apply (a : bs) : offside cs > where (bs, cs) = span (\a' -> col' a < col' a') as -> col' (Atom a) = col a -> col' (Paren a _ _) = col a +> col' (Atom a) = poscol a +> col' (Paren a _ _) = poscol a > > atom :: (CToken tok) => Parser (Pos tok) (Atom (Pos tok)) -> atom = fmap Atom noSep -> `mplus` do l <- left -> e <- chunk -> r <- right l -> return (Paren l e r) +> atom = fmap Atom noSep +> <|> do l <- left +> e <- chunk +> r <- right l +> return (Paren l e r) Primitive parser. @@ -98,8 +96,10 @@ > sep = satisfy (\t -> catCode t == Sep) > noSep = satisfy (\t -> catCode t == NoSep) > left = satisfy (\t -> case catCode t of Del c -> c `elem` "(["; _-> False) -> right l = satisfy (\c -> case (catCode l, catCode c) of -> (Del o, Del c) -> (o,c) `elem` zip "([" ")]" +> +> right :: (CToken tok) => tok -> Parser tok tok +> right l = satisfy (\c' -> case (catCode l, catCode c') of +> (Del o, Del c) -> (o,c) `elem` zip "([" ")]" > _ -> False) % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - @@ -117,11 +117,11 @@ > align :: (CToken tok) => Maybe Int -> [[Pos tok]] -> [Line [Pos tok]] > align c = fmap (maybe Multi split3 c) > where -> split3 i ts = case span (\t -> col t < i) ts of +> split3 i ts = case span (\t -> poscol t < i) ts of > ([], []) -> Blank > ((_ : _), []) -> Multi ts > (us, v : vs) -> | col v == i && isInternal v +> | poscol v == i && isInternal v > -> Three us [v] vs > | null us -> Three [] [] (v : vs) > | otherwise -> Multi ts @@ -135,9 +135,9 @@ > _ -> False > > instance Functor Line where -> fmap f Blank = Blank -> fmap f (Three l c r) = Three (f l) (f c) (f r) -> fmap f (Multi a) = Multi (f a) +> fmap _f Blank = Blank +> fmap f (Three l c r) = Three (f l) (f c) (f r) +> fmap f (Multi a) = Multi (f a) % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - \subsubsection{Adding spaces} @@ -149,16 +149,16 @@ after a keyword (hence |before b| really means not immediately after). > addSpaces :: (CToken tok) => [tok] -> [tok] -> addSpaces ts = before False ts +> addSpaces ts0 = before False ts0 > where -> before b [] = [] -> before b (t : ts) = case token t of +> before _b [] = [] +> before b (t : ts) = case token t of > u | selfSpacing u -> t : before False ts > Special c > | c `elem` ",;([{" -> t : before False ts > Keyword _ -> [ fromToken (TeX False sub'space) | b ] ++ t : after ts > _ -> t : before True ts -> +> > after [] = [] > after (t : ts) = case token t of > u | selfSpacing u -> t : before False ts @@ -187,8 +187,14 @@ > type Stack = [(Col, Doc, [Pos Token])] > -> leftIndent dict auto (lst, rst) -> = loop lst rst +> leftIndent :: +> Formats +> -> Bool +> -> (Stack, Stack) +> -> [Line [Pos Token]] +> -> (Doc, (Stack, Stack)) +> leftIndent dict auto (lst0, rst0) +> = loop lst0 rst0 > where > copy d | auto = d > | otherwise = Empty @@ -197,37 +203,37 @@ @::@, @=@ etc~oder ein Operator wie @++@ ist. > loop lst rst [] = (Empty, (lst, rst)) -> loop lst rst (l : ls) = case l of +> loop lst rst (l' : ls) = case l' of > Blank -> loop lst rst ls -> Three l c r -> (sub'column3 (copy lskip <> latexs dict l) +> Three l c r -> (sub'column3 (copy lskip <<>> latexs dict l) > (latexs dict c) -> (copy rskip <> latexs dict r) <> sep ls <> rest, st') +> (copy rskip <<>> latexs dict r) <<>> sep' ls <<>> rest, st') > where (lskip, lst') = indent l lst > (rskip, rst') = indent r rst > (rest, st') = loop lst' rst' ls -- does not work: |if null l && null c then rst' else []| -> Multi m -> (sub'column1 (copy lskip <> latexs dict m) <> sep ls <> rest, st') +> Multi m -> (sub'column1 (copy lskip <<>> latexs dict m) <<>> sep' ls <<>> rest, st') > where (lskip, lst') = indent m lst > (rest, st') = loop lst' [] ls > -> sep [] = Empty -> sep (Blank : _ ) = sub'blankline -> sep (_ : _) = sub'nl +> sep' [] = Empty +> sep' (Blank : _ ) = sub'blankline +> sep' (_ : _) = sub'nl > > indent :: [Pos Token] -> Stack -> (Doc, Stack) > indent [] stack = (Empty, stack) -> indent ts@(t : _) [] = (Empty, [(col t, Empty, ts)]) +> indent ts@(t : _) [] = (Empty, [(poscol t, Empty, ts)]) > indent ts@(t : _) (top@(c, skip, line) : stack) -> = case compare (col t) c of +> = case compare (poscol t) c of > LT -> indent ts stack > EQ -> (skip, (c, skip, ts) : stack) -> GT -> (skip', (col t, skip', ts) : top : stack) +> GT -> (skip', (poscol t, skip', ts) : top : stack) > where -> skip' = case span (\u -> col u < col t) line of -> (us, v : vs) | col v == col t -> -> skip <> sub'phantom (latexs dict us) +> skip' = case span (\u -> poscol u < poscol t) line of +> (us, v : _vs) | poscol v == poscol t +> -> skip <<>> sub'phantom (latexs dict us) > -- does not work: |(us, _) -> skip ++ [Phantom (fmap token us), Skip (col t - last (c : fmap col us))]| -> _ -> skip <> sub'hskip (Text em) -> where em = showFFloat (Just 2) (0.5 * fromIntegral (col t - c) :: Double) "" +> _ -> skip <<>> sub'hskip (Text em) +> where em = showFFloat (Just 2) (0.5 * fromIntegral (poscol t - c) :: Double) "" M"ussen |v| und |t| zueinander passen? % diff --git a/src/MathCommon.lhs b/src/MathCommon.lhs --- a/src/MathCommon.lhs +++ b/src/MathCommon.lhs @@ -11,16 +11,16 @@ > import Typewriter ( latex ) > import Document -> import Directives +> import Directives ( Formats ) > import HsLexer > import qualified FiniteMap as FM > import Auxiliaries > -> import Control.Monad +> import Control.Applicative > when :: Monad m => Bool -> (a -> m a) -> (a -> m a) > when True f = f -> when False f = return +> when False _f = return % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - \subsubsection{Adding positional information} @@ -29,7 +29,7 @@ > type Row = Int > type Col = Int > -> data Pos a = Pos {row :: !Row, col :: !Col, ann :: a} +> data Pos a = Pos {posrow :: !Row, poscol :: !Col, posann :: a} > deriving (Show) %{ @@ -57,8 +57,8 @@ Numbering the list of tokens. > number :: Row -> Col -> [Token] -> [Pos Token] -> number r c [] = [] -> number r c (t : ts) = Pos r c t : number r' c' ts +> number _r _c [] = [] +> number r c (t : ts) = Pos r c t : number r' c' ts > where (r', c') = count r c (string t) > > count :: Row -> Col -> String -> (Row, Col) @@ -74,7 +74,7 @@ > where > split _ [] = [] > split r ts = us : split (r + 1) vs -> where (us, vs) = span (\t -> row t <= r) ts +> where (us, vs) = span (\t -> posrow t <= r) ts % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - \subsubsection{A very simple Haskell Parser} @@ -85,9 +85,9 @@ possible that the explanation is not adequate: A |Chunk| is a sequence of \emph{delimiters} or \emph{applications}. Delimiters -are keywords or operators. Applications are everything else. +are keywords or operators. Applications are everything else. -An |application| is a sequence of atoms that are forming a Haskell +An |application| is a sequence of atoms that are forming a Haskell function application. The list must never be empty, but can contain a single element (for instance, in normal infix expressions such as |2 + 3| this will occur frequently). @@ -135,7 +135,7 @@ > where > eval :: (CToken tok) => [Item (Pos tok)] -> (Mode,[Pos tok]) > eval [e] = eval' e -> eval chunk = (Optional False, concat [ snd (eval' i) | i <- chunk ]) +> eval chunk' = (Optional False, concat [ snd (eval' i) | i <- chunk' ]) > > eval' :: (CToken tok) => Item (Pos tok) -> (Mode,[Pos tok]) > eval' (Delim s) = (Optional False, [s]) @@ -143,7 +143,7 @@ > eval' (Apply (e : es)) = eval'' False e es > > eval'' :: (CToken tok) => Bool -> Atom (Pos tok) -> [Atom (Pos tok)] -> (Mode,[Pos tok]) -> eval'' _ (Atom s) es = case FM.lookup (string (token s) ++ pos2string s) d `mplus` FM.lookup (string (token s)) d of +> eval'' _ (Atom s) es = case FM.lookup (string (token s) ++ pos2string s) d <|> FM.lookup (string (token s)) d of > Nothing -> (Optional False, s : args es) > Just (opt, opts, lhs, rhs)-> (Optional opt, set s (concat (fmap sub rhs)) ++ args bs) > where @@ -161,10 +161,10 @@ inherits the position of the original token. > eval'' opt (Paren l e r) es -> | optional = (Mandatory, set l s ++ args es) +> | isOptional = (Mandatory, set l s ++ args es) > | otherwise = (Optional False, [l] ++ s ++ [r] ++ args es) > where (flag, s) = eval e -> optional = catCode l == Del '(' && not (mandatory e) +> isOptional = catCode l == Del '(' && not (mandatory e) > && case flag of Mandatory -> False; Optional f -> opt || f \NB It is not a good idea to remove parentheses around atoms, because @@ -180,11 +180,11 @@ To support macros of the form @%format Parser (a) = a@. > set :: (CToken tok) => tok -> [tok] -> [tok] -> set s [] = [] -> set s (t : ts) = inherit s (token t) : ts +> set _s [] = [] +> set s (t : ts) = inherit s (token t) : ts > > mandatory :: (CToken tok) => Chunk tok -> Bool -> mandatory e = False +> mandatory _e = False Code before: diff --git a/src/MathPoly.lhs b/src/MathPoly.lhs --- a/src/MathPoly.lhs +++ b/src/MathPoly.lhs @@ -14,20 +14,17 @@ > where > > import Prelude hiding ( lines ) -> import Data.List ( partition, nub, insert, sort, transpose ) -> import Numeric ( showFFloat ) -> import Control.Applicative ( many ) +> import Data.List ( partition, nub, sort, transpose ) +> import Control.Applicative > import Control.Arrow ( (>>>) ) -> import Control.Monad ( MonadPlus(..), (>=>) ) +> import Control.Monad ( (>=>) ) > > import Verbatim ( expand, trim ) -> import Typewriter ( latex ) > import MathCommon > import Document > import Directives > import HsLexer > import Parser -> import qualified FiniteMap as FM > import Auxiliaries > import TeXCommands ( Lang(..) ) > -- import Debug.Trace ( trace ) @@ -54,7 +51,7 @@ > display :: Lang -> Int -> Formats -> Bool -> Int -> Int -> Stack > -> String -> Either Exc (Doc, Stack) -> display lang line fmts auto sep lat stack +> display lang line fmts auto sep lat _stack > = lift trim > >=> lift (expand 0) > >=> tokenize lang @@ -69,7 +66,7 @@ > >=> lift (\ts -> (autoalign sep ts,ts)) > -- |>=> lift (\(x,y) -> trace ((unlines $ map show $ y) ++ "\n" ++ show x) (x,y))| > >=> lift (\(cs,ts) -> let ats = align cs sep lat ts -> cs' = [("B",0)] ++ cs +> cs' = [("B",0)] ++ cs > ++ [("E",error "E column")] > in (autocols cs' ats,ats) > ) @@ -79,10 +76,10 @@ > >=> return *** lift (\(z,ats) -> leftIndent fmts auto z [] ats) > -- ks, 17.07.2003: i've changed "stack" into "[]" and thereby disabled > -- the global stack for now as it leads to unexepected behaviour -> >=> lift (\(cs,(d,stack)) -> (sub'code (columns cs <> d),stack)) +> >=> lift (\(cs,(d,stack)) -> (sub'code (columns cs <<>> d),stack)) > > columns :: [(String,Doc)] -> Doc -> columns = foldr (<>) Empty +> columns = foldr (<<>>) Empty > . map (uncurry sub'column) % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - @@ -99,24 +96,24 @@ > > chunk :: (CToken tok) => Int -> Parser (Pos tok) (Chunk (Pos tok)) > chunk d = do a <- many (atom d) -> as <- many (do s <- sep; a <- many (atom d); return (Delim s : offside a)) +> as <- many (do s <- csep; a' <- many (atom d); return (Delim s : offside a')) > return (offside a ++ concat as) > where offside [] = [] > -- old: |opt a = [Apply a]| > offside (a : as) = Apply (a : bs) : offside cs > where (bs, cs) = span (\a' -> col' a < col' a') as -> col' (Atom a) = col a -> col' (Paren a _ _) = col a +> col' (Atom a) = poscol a +> col' (Paren a _ _) = poscol a > > atom :: (CToken tok) => Int -> Parser (Pos tok) (Atom (Pos tok)) -> atom d = fmap Atom noSep -> `mplus` do l <- left -> e <- chunk (d+1) -> r <- right l -> return (Paren l e r) -> `mplus` if d == 0 then do r <- anyright -> return (Paren (fromToken $ TeX False Empty) [] r) -> else mzero +> atom d = fmap Atom cnoSep +> <|> do l <- left +> e <- chunk (d+1) +> r <- right l +> return (Paren l e r) +> <|> if d == 0 then do r <- anyright +> return (Paren (fromToken $ TeX False Empty) [] r) +> else empty ks, 09.09.2003: Added handling of unbalanced parentheses, surely not in the most elegant way. Both |chunk| and |atom| now take an integer argument @@ -126,16 +123,18 @@ Primitive parser. -> sep, noSep, left, anyright :: (CToken tok) => Parser tok tok -> sep = satisfy (\t -> catCode t == Sep) -> noSep = satisfy (\t -> catCode t == NoSep) +> csep, cnoSep, left, anyright :: (CToken tok) => Parser tok tok +> csep = satisfy (\t -> catCode t == Sep) +> cnoSep = satisfy (\t -> catCode t == NoSep) > left = satisfy (\t -> case catCode t of Del c -> c `elem` "([{"; _ -> False) > anyright = satisfy (\t -> case catCode t of Del c -> c `elem` ")]}"; _ -> False) -> right l = satisfy (\c -> case (catCode l, catCode c) of -> (Del o, Del c) -> (o,c) `elem` zip "([{" ")]}" -> _ -> False) -> `mplus` do eof -> return (fromToken $ TeX False Empty) +> +> right :: (CToken tok) => tok -> Parser tok tok +> right l = satisfy (\c' -> case (catCode l, catCode c') of +> (Del o, Del c) -> (o,c) `elem` zip "([{" ")]}" +> _ -> False) +> <|> do eof +> return (fromToken $ TeX False Empty) ks, 06.09.2003: Modified the |right| parser to accept the end of file, to allow for unbalanced parentheses. This behaviour is not (yet) backported @@ -154,20 +153,20 @@ > autoalign sep toks = map (\x -> (show x,x)) > . nub > . sort -> . concat -> . fmap findCols +> . concat +> . fmap findCols > $ toks > where > findCols :: (CToken tok,Show tok) => [Pos tok] -> [Col] -> findCols ts = case {- |trace (show ts)| -} +> findCols ts = case {- |trace (show ts)| -} > (break (\t -> not . isNotSpace . token $ t) ts) of > (_, []) -> [] -- done -> (_, [v]) -> [] -- last token is whitespace, doesn't matter +> (_, [_v]) -> [] -- last token is whitespace, doesn't matter > (_, v:v':vs) -> | row v' == 0 && col v' == 0 +> | posrow v' == 0 && poscol v' == 0 > -> findCols (v:vs) -- skip internal tokens (automatically added spaces) > | length (string (token v)) >= sep -> -> {- |trace ("found: " ++ show (col v')) $| -} col v' : findCols (v':vs) +> -> {- |trace ("found: " ++ show (col v')) $| -} poscol v' : findCols (v':vs) > | otherwise -> {- |trace ("found too short")| -} findCols (v':vs) ks, 21.11.2005: I've fixed a bug that was known to me since long ago, but I never got @@ -183,24 +182,24 @@ > align cs sep lat toks = fmap (\t -> {- |trace (show (map token t) ++ "\n") $| -} > let res = splitn ("B",0) False cs t > in if null [x | x <- t -> , (row x /= 0 || col x /= 0) && isNotSpace (token x)] -> || null res +> , (posrow x /= 0 || poscol x /= 0) && isNotSpace (token x)] +> || null res > then Blank > else Poly res > ) toks > where -> splitn cc ind [] [] = [] -> splitn cc ind [] ts = [(cc,ts,ind)] -> splitn cc ind ((n,i):oas) ts= -> case span (\t -> col t < i) ts of +> splitn _cc _ind [] [] = [] +> splitn cc ind [] ts = [(cc,ts,ind)] +> splitn cc ind ((n,i):oas) ts= +> case span (\t -> poscol t < i) ts of > ([], vs) -> splitn cc ind oas vs > (us, []) -> [(cc,us,ind)] -> (us, (v:vs)) -> -> let lu = head [ u | u <- reverse us, col u /= 0 || row u /= 0 ] +> (us, (v:vs)) -> +> let lu = head [ u | u <- reverse us, poscol u /= 0 || posrow u /= 0 ] > -- again, we skip automatically added spaces > llu = length (string (token lu)) > in case () of -> _ | (lat /= 0 && isNotSpace (token lu)) || llu < lat || col v /= i +> _ | (lat /= 0 && isNotSpace (token lu)) || llu < lat || poscol v /= i > -- no alignment for this column > -> splitn cc ind oas (us ++ (v:vs)) > | not (isNotSpace (token lu)) && llu >= sep @@ -220,8 +219,8 @@ > _ -> False > > instance Functor Line where -> fmap f Blank = Blank -> fmap f (Poly ls) = Poly (map (\(x,y,z) -> (x,f y,z)) ls) +> fmap _f Blank = Blank +> fmap f (Poly ls) = Poly (map (\(x,y,z) -> (x,f y,z)) ls) % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - \subsubsection{Automatically determining centered columns} @@ -235,8 +234,8 @@ > autocols :: (CToken tok, Show tok) => [(String,Int)] -- column info > -> [Line [Pos tok]] -- aligned tokens > -> ([(String,Doc)],[Col]) -- cols+alignment, plus centered columns -> autocols cs ats = (\(x,y) -> (concat x,concat y)) $ unzip -> $ zipWith3 (\(cn,n) ml ai -> +> autocols cs ats = (\(x,y) -> (concat x,concat y)) $ unzip +> $ zipWith3 (\(cn,n) ml ai -> > if ml <= 2 && ai then ([(cn,sub'centered) > ,(cn ++ "E",sub'dummycol) > ],[n]) @@ -248,14 +247,16 @@ > maxlengths = {- |trace (show cts) $ |-} map (maximum . map length) cts > anyinternals = map (any (any isInternal)) cts > -> -- deline :: [(String,Int)] -> Line [a] -> [[[a]]] -> deline cs Blank = [] -> deline cs (Poly ls) = [decol cs ls] +> deline :: [(String,Int)] -> Line [a] -> [[[a]]] +> deline _cs' Blank = [] +> deline cs' (Poly ls) = [decol cs' ls] > -> decol cs [] = replicate (length cs) [] -> decol ((cn,_):cs) r@(((cn',_),ts,_):rs) -> | cn' == cn = ts : decol cs rs -> | otherwise = [] : decol cs r +> decol :: [(String, Int)] -> [((String, Int), [a], Bool)] -> [[a]] +> decol cs' [] = replicate (length cs') [] +> decol ((cn,_):cs') r@(((cn',_),ts,_):rs) +> | cn' == cn = ts : decol cs' rs +> | otherwise = [] : decol cs' r +> decol _ _ = impossible "autocols.decol" % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - \subsubsection{Adding spaces} @@ -267,17 +268,17 @@ after a keyword (hence |before b| really means not immediately after). > addSpaces :: (CToken tok) => [tok] -> [tok] -> addSpaces ts = before False ts +> addSpaces ts0 = before False ts0 > where -> before b [] = [] -> before b (t : ts) = case token t of +> before _b [] = [] +> before b (t : ts) = case token t of > u | not (isNotSpace u)-> t : before b ts > | selfSpacing u -> t : before False ts > Special c > | c `elem` ",;([{" -> t : before False ts > Keyword _ -> [ fromToken (TeX False sub'space) | b ] ++ t : after ts > _ -> t : before True ts -> +> > after [] = [] > after (t : ts) = case token t of > u | not (isNotSpace u)-> t : after ts @@ -330,49 +331,46 @@ As a final step, the current line is placed on the stack. -> leftIndent :: Formats -> Bool +> leftIndent :: Formats -> Bool > -> [Col] -- centered columns > -> Stack -- current stack > -> [Line [Pos Token]] > -> (Doc, Stack) -> leftIndent dict auto z stack -> = loop True stack +> leftIndent dict _auto z stack0 +> = loop True stack0 > where -> copy d | auto = d -> | otherwise = Empty - > loop :: Bool -> Stack -> [Line [Pos Token]] -> (Doc, Stack) -> loop first stack [] = (Empty, stack) -- done -> loop first stack (l:ls) = case l of +> loop _first stack [] = (Empty, stack) -- done +> loop first stack (l:ls) = case l of > Blank -> loop True stack ls -- ignore blank lines > {-| Poly x || trace (show x) False -> undefined |-} > Poly [] -> loop True stack ls -- next line -> Poly (((n,c),[],ind):rs) +> Poly (((_n,_c),[],_ind):rs) > | first -> loop True stack (Poly rs:ls) -- ignore leading blank columns -> Poly p@(((n,c),ts,ind):rs) +> Poly p@(((n,c),ts,_ind):rs) > | first -> -- check indentation > let -- step 1: shrink stack -> rstack = dropWhile (\(rc,_) -> rc >= c) stack +> rstack = dropWhile (\(rc',_) -> rc' >= c) stack > -- step 2: find relevant column > (rn,rc) = findrel (n,c) rstack > -- step 3: place line on stack > fstack = (c,l) : rstack > in mkFromTo fstack rn n rc [fromToken $ TeX False (indent (rn,rc) (n,c))] p ls -> > +> > | c `elem` z -> mkFromTo stack n (n ++ "E") c ts rs ls > -- treat centered lines special -> Poly [((n,c),ts,ind)] -> mkFromTo stack n "E" c ts [] ls +> Poly [((n,c),ts,_ind)] -> mkFromTo stack n "E" c ts [] ls > -- last columns -> Poly (((n,c),ts,ind):rs@(((nn,_),_,_):_)) -> -> mkFromTo stack n nn c ts rs ls +> Poly (((n,c),ts,_ind):rs@(((nn,_),_,_):_)) +> -> mkFromTo stack n nn c ts rs ls > > mkFromTo :: Stack -> String -> String -> Col -> [Pos Token] -> [((String, Int), [Pos Token], Bool)] -> [Line [Pos Token]] -> (Doc, Stack) -> mkFromTo stack bn en c ts rs ls +> mkFromTo stack bn en _c ts rs ls > | bn == en = -- this can happen at the beginning of a line due to indentation > (rest,stack') > | otherwise = (sub'fromto bn en (latexs dict ts) -> <> (if null rs then sep ls else Empty) <> rest +> <<>> (if null rs then sep ls else Empty) <<>> rest > ,stack' > ) > where @@ -384,8 +382,8 @@ > findrel :: (String,Col) -> Stack -> (String,Col) > findrel (n,c) [] = (n,c) > findrel (n,c) ((_,Blank):r) = findrel (n,c) r -- should never happen -> findrel (n,c) ((_,Poly t):_) -> = case break (\((n',c'),_,_) -> c' > c) t of +> findrel (_n,c) ((_,Poly t):_) +> = case break (\((_n',c'),_,_) -> c' > c) t of > ([],_) -> error "findrel: the impossible happened" > (pre,_) -> let ((rn,rc),_,_) = last pre > in (rn,rc) @@ -395,7 +393,7 @@ > sep (_ : _) = sub'nl > > indent :: (String,Int) -> (String,Int) -> Doc -> indent (n,c) (n',c') +> indent (_n,c) (_n',c') > | c /= c' = sub'indent (Text (show (c' - c))) > | otherwise = Empty diff --git a/src/NewCode.lhs b/src/NewCode.lhs --- a/src/NewCode.lhs +++ b/src/NewCode.lhs @@ -13,6 +13,7 @@ > module NewCode ( module NewCode ) > where > +> import Control.Arrow ( (>>>) ) > import Control.Monad ( (>=>) ) > import Data.List ( partition ) > @@ -47,6 +48,22 @@ > >=> lift (latexs sub'space sub'nl fmts) > >=> lift sub'code +ks, 2016-08-12: +Since we're now reusing this for markdown mode, we need an |inline| function +after all: + +> inline :: Lang -> Formats -> String -> Either Exc Doc +> inline lang fmts = fmap unNL +> >>> tokenize lang +> >=> lift (number 1 1) +> >=> lift (partition (\t -> catCode t /= White)) +> >=> exprParse *** return +> >=> lift (substitute fmts False) *** return +> >=> lift (uncurry merge) +> >=> lift (fmap token) +> >=> lift (latexs sub'space sub'nl fmts) +> >=> lift sub'inline + % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - \subsubsection{Encoding} % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - @@ -66,11 +83,11 @@ > latex sp nl dict = tex Empty > where > tex _ (Space s) = sub'spaces (convert s) -> tex q (Conid s) = replace q s (sub'conid (q <> convert s)) +> tex q (Conid s) = replace q s (sub'conid (q <<>> convert s)) > tex _ (Varid "") = sub'dummy -- HACK -> tex q (Varid s) = replace q s (sub'varid (q <> convert s)) -> tex q (Consym s) = replace q s (sub'consym (q <> convert s)) -> tex q (Varsym s) = replace q s (sub'varsym (q <> convert s)) +> tex q (Varid s) = replace q s (sub'varid (q <<>> convert s)) +> tex q (Consym s) = replace q s (sub'consym (q <<>> convert s)) +> tex q (Varsym s) = replace q s (sub'varsym (q <<>> convert s)) > tex _ (Numeral s) = replace Empty s (sub'numeral (convert s)) -- NEU > tex _ (Char s) = sub'char (catenate (map conv (init $ tail s))) -- NEW: remove quotes > tex _ (String s) = sub'string (catenate (map conv (init $ tail s))) -- NEW: remove quotes @@ -81,17 +98,15 @@ > tex _ (Keyword s) = replace Empty s (sub'keyword (convert s)) > tex _ (TeX False d) = d > tex _ (TeX True d) = sub'tex d -> tex _ t@(Qual ms t') = replace Empty (string t) (tex (catenate (map (\m -> tex Empty (Conid m) <> Text ".") ms)) t') +> tex _ t@(Qual ms t') = replace Empty (string t) (tex (catenate (map (\m -> tex Empty (Conid m) <<>> Text ".") ms)) t') > tex _ t@(Op t') = replace Empty (string t) (sub'backquoted (tex Empty t')) -> where cmd | isConid t'= sub'consym -> | otherwise = sub'varsym > > replace q s def = case FM.lookup s dict of -> Just (_, _, [], ts) -> q <> catenate (map (tex Empty) ts) +> Just (_, _, [], ts) -> q <<>> catenate (map (tex Empty) ts) > _ -> def \NB the directives @%format a = b@ and @%format b = a@ cause a loop. - + \NB Only nullary macros are applied. Conversion of strings and characters. diff --git a/src/Parser.lhs b/src/Parser.lhs --- a/src/Parser.lhs +++ b/src/Parser.lhs @@ -7,10 +7,8 @@ > module Parser ( Parser, run, satisfy, lit, lits, wrap, nonnull, eof ) > where > -> import Data.Char ( isSpace ) -> import Auxiliaries > import Control.Applicative -> import Control.Monad ( MonadPlus(..), filterM, ap ) +> import Control.Monad ( MonadPlus(..), ap, mfilter ) %endif Deterministische Mini-Parser. @@ -19,6 +17,7 @@ %format (unParser (p)) = p %else +> unParser :: Parser tok a -> [tok] -> Maybe (a, [tok]) > unParser (MkParser p) = p %endif @@ -36,7 +35,7 @@ > Nothing -> Nothing > Just (a, rest) -> unParser (k a) rest) > instance MonadPlus (Parser tok) where -> mzero = MkParser (\inp -> Nothing) +> mzero = MkParser (\_inp -> Nothing) > m `mplus` n = MkParser (\inp -> unParser m inp `mplus` unParser n inp) > instance Applicative (Parser tok) where > pure = return @@ -46,9 +45,9 @@ > (<|>) = mplus > > satisfy :: (tok -> Bool) -> Parser tok tok -> satisfy pred = MkParser (\inp -> case inp of -> a : rest | pred a -> Just (a, rest) -> _ -> Nothing) +> satisfy p = MkParser (\inp -> case inp of +> a : rest | p a -> Just (a, rest) +> _ -> Nothing) > > lit :: (Eq tok) => tok -> Parser tok tok > lit c = satisfy (== c) @@ -74,8 +73,6 @@ > > nonnull :: ([tok] -> ([a], [tok])) -> Parser tok [a] > nonnull f = mfilter (not . null) (wrap f) - -> mfilter p m = m >>= \a -> if p a then return a else mzero %if False diff --git a/src/StateT.lhs b/src/StateT.lhs --- a/src/StateT.lhs +++ b/src/StateT.lhs @@ -5,14 +5,13 @@ %if codeOnly || showModuleHeader > {-# LANGUAGE GeneralizedNewtypeDeriving #-} +> {-# OPTIONS_GHC -fno-warn-unused-imports #-} > module StateT ( module StateT ) > where > -> import Control.Applicative -> import Control.Monad.Error +> import Control.Applicative -- only needed for older GHCs +> import Control.Monad.Except > import Control.Monad.State -> -> import Auxiliaries %endif @@ -23,7 +22,7 @@ %format unXIO (m) = m %endif -> newtype XIO exc st a = MkXIO (ErrorT exc (StateT st IO) a) +> newtype XIO exc st a = MkXIO (ExceptT exc (StateT st IO) a) > deriving (Functor, Applicative, Monad, MonadIO, MonadState st, MonadError exc) -- XIO exc st a ~= StateT st IO (Either exc a) @@ -31,18 +30,19 @@ %if style /= math +> unXIO :: XIO exc st a -> ExceptT exc (StateT st IO) a > unXIO (MkXIO f) = f %endif \NB The state is preserved upon failure. -> toIO :: Error exc => XIO exc st a -> IO a +> toIO :: XIO exc st a -> IO a > toIO (MkXIO m) = do -> (r, _) <- runStateT (runErrorT m) +> (r, _) <- runStateT (runExceptT m) > (error "no initial state supplied") > case r of Left _ -> error "unhandled error" > Right x -> return x -> fromEither :: Error exc => Either exc a -> XIO exc st a +> fromEither :: Either exc a -> XIO exc st a > fromEither = either throwError return diff --git a/src/TeXCommands.lhs b/src/TeXCommands.lhs --- a/src/TeXCommands.lhs +++ b/src/TeXCommands.lhs @@ -8,7 +8,6 @@ > where > > import Data.Maybe -> import FiniteMap ( FiniteMap ) > import qualified FiniteMap as FM > import Auxiliaries @@ -16,7 +15,7 @@ These don't really belong into a module named TeXCommands: -> data Style = Version | Help | SearchPath | Copying | Warranty | CodeOnly | NewCode | Verb | Typewriter | Poly | Math | Pre +> data Style = Version | Help | SearchPath | Copying | Warranty | CodeOnly | NewCode | Verb | Typewriter | Poly | Markdown | Math | Pre > deriving (Eq, Show, Enum, Bounded) > data Lang = Haskell | Agda @@ -69,7 +68,7 @@ > class Representation a where > representation :: [(String, a)] > instance Representation Style where -> representation = [ ("tt", Typewriter), ("math", Math), ("poly", Poly), +> representation = [ ("tt", Typewriter), ("math", Math), ("poly", Poly), ("markdown", Markdown), > ("verb", Verb), ("code", CodeOnly), ("newcode",NewCode), > ("pre", Pre), ("version", Version), > ("copying", Copying), ("warranty", Warranty), ("help", Help), ("searchpath", SearchPath) ] diff --git a/src/TeXParser.lhs b/src/TeXParser.lhs --- a/src/TeXParser.lhs +++ b/src/TeXParser.lhs @@ -72,12 +72,12 @@ > (env, '}' : u) -> case encode env of > Nothing -> cont > Just cmd -> | pred v -> Environment cmd (arg ++ w) : classify x +> | p v -> Environment cmd (arg ++ w) : classify x > | otherwise -> notFound end str : cont > where > end = "\\end{" ++ env ++ "}" -> pred = isPrefixOf end -> (arg, v) = breaks maxLine pred u +> p = isPrefixOf end +> (arg, v) = breaks maxLine p u > (w, x) = blank (drop (length end) v) > _ -> cont @@ -92,8 +92,8 @@ > (cmd, '{' : t) -> case encode cmd of > Nothing -> cont -> Just cmd -> case nested maxChar 0 t of -> (a, '}' : u) -> Command cmd a : classify u +> Just cmd' -> case nested maxChar 0 t of +> (a, '}' : u) -> Command cmd' a : classify u > _ -> notFound "matching `}'" str : cont > ([], '%' : t) -> Many "\\%" : classify t > _ -> cont @@ -141,24 +141,24 @@ curly braces. > nested :: Int -> Int -> String -> (String, String) -> nested n depth s = nest n s +> nested n' depth s' = nest n' s' > where -> nest 0 s = ([], s) -> nest n [] = ([], []) +> nest 0 s = ([], s) +> nest _n [] = ([], []) > nest n ('}' : s) > | depth == 0 = ([], '}' : s) > | otherwise = '}' <| nested (n - 1) (depth - 1) s -> nest n ('{' : s) = '{' <| nested (n - 1) (depth + 1) s -> nest n ('\\' : c : s) = '\\' <| c <| nest (n - 2) s -> nest n (c : s) = c <| nest (n - 1) s +> nest n ('{' : s) = '{' <| nested (n - 1) (depth + 1) s +> nest n ('\\' : c : s) = '\\' <| c <| nest (n - 2) s +> nest n (c : s) = c <| nest (n - 1) s The function |verb n c| recognizes arguments enclosed in |c|. > verb :: Int -> Char -> String -> (String, String) -> verb 0 c s = ([], s) -> verb n c [] = ([], []) +> verb 0 _c s = ([], s) +> verb _n _c [] = ([], []) > verb n c (c' : s) -> | c == c' = ([], c' : s) +> | c == c' = ([], c' : s) > | otherwise = c' <| verb (n - 1) c s The function |inline n| recognizes arguments enclosed in vertical bars @@ -166,28 +166,28 @@ equivalent to |verb n '||'|). > inline :: Int -> String -> (String, String) -> inline 0 s = ([], s) -> inline n [] = ([], []) -> inline n ('|' : '|' : s) = '|' <| inline (n - 2) s -> inline n ('|' : s) = ([], '|' : s) -> inline n (c : s) = c <| inline (n - 1) s +> inline 0 s = ([], s) +> inline _n [] = ([], []) +> inline n ('|' : '|' : s) = '|' <| inline (n - 2) s +> inline _n ('|' : s) = ([], '|' : s) +> inline n (c : s) = c <| inline (n - 1) s > > shortverb :: Int -> String -> (String, String) -> shortverb 0 s = ([], s) -> shortverb n [] = ([], []) -> shortverb n ('@' : '@' : s) = '@' <| shortverb (n - 2) s -> shortverb n ('@' : s) = ([], '@' : s) -> shortverb n (c : s) = c <| shortverb (n - 1) s +> shortverb 0 s = ([], s) +> shortverb _n [] = ([], []) +> shortverb n ('@' : '@' : s) = '@' <| shortverb (n - 2) s +> shortverb _n ('@' : s) = ([], '@' : s) +> shortverb n (c : s) = c <| shortverb (n - 1) s The function |unbird| recognizes code sections marked by bird tracks; |blank| skips the next line if it is blank. > unbird :: Char -> String -> (String, String) -> unbird c [] = ([], []) -> unbird c ('\n' : c' : s) +> unbird _c [] = ([], []) +> unbird c ('\n' : c' : s) > | c == c' = '\n' <| ' ' <| unbird c s -> unbird c ('\n' : s) = '\n' <| blank s -> unbird c (c' : s) = c' <| unbird c s +> unbird _c ('\n' : s) = '\n' <| blank s +> unbird c (c' : s) = c' <| unbird c s > > blank :: String -> (String, String) > blank s | all isSpace t = (t, u) @@ -198,10 +198,10 @@ holds and |x| is as small as possible (but at most of length |n|). > breaks :: Int -> ([a] -> Bool) -> [a] -> ([a], [a]) -> breaks n pred [] = ([], []) -> breaks n pred as@(a : as') -> | n == 0 || pred as = ([], as) -> | otherwise = a <| breaks (n - 1) pred as' +> breaks _n _p [] = ([], []) +> breaks n p as@(a : as') +> | n == 0 || p as = ([], as) +> | otherwise = a <| breaks (n - 1) p as' % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - \subsubsection{Post processing} @@ -209,14 +209,15 @@ Collaps adjacent |One|'s into a |Many|. -> compress = foldr (<|) [] +> compress :: [Class] -> [Class] +> compress = foldr (<<|) [] > where -> One '\n' <| ts = Many "\n" : ts -> Many s@('\n' : _) <| ts = Many s : ts -> One c <| (Many s : ts) = Many (c : s) : ts -> One c <| ts = Many [c] : ts -> Many s <| (Many s' : ts) = Many (s ++ s') : ts -> t <| ts = t : ts +> One '\n' <<| ts = Many "\n" : ts +> Many s@('\n' : _) <<| ts = Many s : ts +> One c <<| (Many s : ts) = Many (c : s) : ts +> One c <<| ts = Many [c] : ts +> Many s <<| (Many s' : ts) = Many (s ++ s') : ts +> t <<| ts = t : ts \NB The first two equations make |compress| incrementel (?); otherwise \[ @@ -227,10 +228,10 @@ Adding line numbers. > number :: LineNo -> [Class] -> [Numbered Class] -> number n [] = [] -> number n (t : ts) = No n t : number (n + i) ts +> number _n [] = [] +> number n (t : ts) = No n t : number (n + i) ts > where i = case t of -> One c -> impossible "number" +> One _c -> impossible "number" > Many s -> newlines s > Inline s -> newlines s > Command _ s -> newlines s diff --git a/src/Typewriter.lhs b/src/Typewriter.lhs --- a/src/Typewriter.lhs +++ b/src/Typewriter.lhs @@ -45,11 +45,11 @@ > latex sp nl dict = tex Empty > where > tex _ (Space s) = sub'spaces (convert False s) -> tex q (Conid s) = replace q s (sub'conid (q <> convert False s)) +> tex q (Conid s) = replace q s (sub'conid (q <<>> convert False s)) > tex _ (Varid "") = sub'dummy -- HACK -> tex q (Varid s) = replace q s (sub'varid (q <> convert False s)) -> tex q (Consym s) = replace q s (sub'consym (q <> convert False s)) -> tex q (Varsym s) = replace q s (sub'varsym (q <> convert False s)) +> tex q (Varid s) = replace q s (sub'varid (q <<>> convert False s)) +> tex q (Consym s) = replace q s (sub'consym (q <<>> convert False s)) +> tex q (Varsym s) = replace q s (sub'varsym (q <<>> convert False s)) > tex _ (Numeral s) = replace Empty s (sub'numeral (convert True s)) -- NEU > tex _ (Char s) = sub'char (catenate (map conv' (init $ tail s))) -- NEW: remove quotes > tex _ (String s) = sub'string (catenate (map conv' (init $ tail s))) -- NEW: remove quotes @@ -60,17 +60,15 @@ > tex _ (Keyword s) = replace Empty s (sub'keyword (convert False s)) > tex _ (TeX False d) = d > tex _ (TeX True d) = sub'tex d -> tex _ t@(Qual ms t') = replace Empty (string t) (tex (catenate (map (\m -> tex Empty (Conid m) <> Text ".") ms)) t') +> tex _ t@(Qual ms t') = replace Empty (string t) (tex (catenate (map (\m -> tex Empty (Conid m) <<>> Text ".") ms)) t') > tex _ t@(Op t') = replace Empty (string t) (sub'backquoted (tex Empty t')) -> where cmd | isConid t'= sub'consym -> | otherwise = sub'varsym > > replace q s def = case FM.lookup s dict of -> Just (_, _, [], ts) -> q <> catenate (map (tex Empty) ts) +> Just (_, _, [], ts) -> q <<>> catenate (map (tex Empty) ts) > _ -> def \NB the directives @%format a = b@ and @%format b = a@ cause a loop. - + \NB Only nullary macros are applied. Conversion of strings and characters. The Boolean indicates whether we diff --git a/src/Value.lhs b/src/Value.lhs --- a/src/Value.lhs +++ b/src/Value.lhs @@ -16,19 +16,19 @@ Dynamic conversion routines. -> str :: Value -> String +> str :: Value -> String > str Undef = "" > str (Str s) = s > str (Bool b) = if b then "True" else "" > str (Int i) = show i > -> bool :: Value -> Bool +> bool :: Value -> Bool > bool Undef = False > bool (Str s) = not (null s) > bool (Bool b) = b > bool (Int i) = i /= 0 > -> int :: Value -> Int +> int :: Value -> Int > int Undef = 0 > int (Str s) = case reads s of > [(i, [])] -> i @@ -60,27 +60,32 @@ > type Binary a = a -> a -> a > > onStr2 :: Binary String -> Binary Value -> onStr2 (++) v1 v2 = Str (str v1 ++ str v2) +> onStr2 op v1 v2 = Str (str v1 `op` str v2) > > onBool2 :: Binary Bool -> Binary Value -> onBool2 (||) v1 v2 = Bool (bool v1 || bool v2) +> onBool2 op v1 v2 = Bool (bool v1 `op` bool v2) > > onInt2 :: Binary Int -> Binary Value -> onInt2 (+) v1 v2 = Int (int v1 + int v2) +> onInt2 op v1 v2 = Int (int v1 `op` int v2) %align 41 {\setlength{\lwidth}{5.5cm} -> onMatching f g h Undef (Str s2) = Bool (f (str Undef) s2) -> onMatching f g h (Str s1) Undef = Bool (f s1 (str Undef)) -> onMatching f g h (Str s1) (Str s2) = Bool (f s1 s2) -> onMatching f g h Undef (Bool b2) = Bool (g (bool Undef) b2) -> onMatching f g h (Bool b1) Undef = Bool (g b1 (bool Undef)) -> onMatching f g h (Bool b1) (Bool b2) = Bool (g b1 b2) -> onMatching f g h Undef (Int i2) = Bool (h (int Undef) i2) -> onMatching f g h (Int i1) Undef = Bool (h i1 (int Undef)) -> onMatching f g h (Int i1) (Int i2) = Bool (h i1 i2) -> onMatching _ _ _ _ _ = Bool False +> onMatching :: +> (String -> String -> Bool) +> -> (Bool -> Bool -> Bool) +> -> (Int -> Int -> Bool) +> -> Value -> Value -> Value +> onMatching f _g _h Undef (Str s2) = Bool (f (str Undef) s2) +> onMatching f _g _h (Str s1) Undef = Bool (f s1 (str Undef)) +> onMatching f _g _h (Str s1) (Str s2) = Bool (f s1 s2) +> onMatching _f g _h Undef (Bool b2) = Bool (g (bool Undef) b2) +> onMatching _f g _h (Bool b1) Undef = Bool (g b1 (bool Undef)) +> onMatching _f g _h (Bool b1) (Bool b2) = Bool (g b1 b2) +> onMatching _f _g h Undef (Int i2) = Bool (h (int Undef) i2) +> onMatching _f _g h (Int i1) Undef = Bool (h i1 (int Undef)) +> onMatching _f _g h (Int i1) (Int i2) = Bool (h i1 i2) +> onMatching _ _ _ _ _ = Bool False } %} diff --git a/src/Verbatim.lhs b/src/Verbatim.lhs --- a/src/Verbatim.lhs +++ b/src/Verbatim.lhs @@ -37,8 +37,8 @@ > >>> sub'verbatim > > splice :: [Doc] -> Doc -> splice ds = Text "~" <> catenate (intersperse nl ds) -> where nl = Text "!" <> sub'verbnl <> Text "!" +> splice ds = Text "~" <<>> catenate (intersperse nl ds) +> where nl = Text "!" <<>> sub'verbnl <<>> Text "!" > > latexs :: Bool -> String -> Doc > latexs b = catenate . map latex @@ -75,9 +75,9 @@ Expanding tabs (assuming a tabulator width of $8$ characters). > expand :: Int -> String -> String -> expand n [] = [] -> expand n ('\n' : s) = '\n' : expand 0 s -> expand n ('\t' : s) = replicate (n' - n) ' ' ++ expand n' s +> expand _n [] = [] +> expand _n ('\n' : s) = '\n' : expand 0 s +> expand n ('\t' : s) = replicate (n' - n) ' ' ++ expand n' s > where n' = (n + 8) `div` 8 * 8 -> expand n (c : s) = c : expand (n + 1) s +> expand n (c : s) = c : expand (n + 1) s diff --git a/src/Version.lhs.in b/src/Version.lhs.in --- a/src/Version.lhs.in +++ b/src/Version.lhs.in @@ -21,12 +21,14 @@ > pre :: Int > pre = @PRE@ +> isWindows :: Bool > isWindows = "win" `isPrefixOf` os || "Win" `isPrefixOf` os % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - \subsubsection{Search path} % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - - +> searchPath :: [FilePath] > searchPath = "." : > [ deep (joinPath (env "HOME" : [p ++ x])) > | p <- ["","."] @@ -50,6 +52,7 @@ > ,"lhs2TeX" > ] > +> stydir :: FilePath > stydir = replace (replace "@stydir@" "datarootdir" "@datarootdir@") "prefix" "@prefix@" > where replace x w y | ("$" ++ w) `isPrefixOf` x = y ++ drop (length w + 1) x > | ("${" ++ w ++ "}") `isPrefixOf` x = y ++ drop (length w + 3) x