2007-11-03 23:27:58 +00:00
|
|
|
|
{-
|
2012-01-29 23:54:00 -08:00
|
|
|
|
Copyright (C) 2006-2012 John MacFarlane <jgm@berkeley.edu>
|
2007-11-03 23:27:58 +00:00
|
|
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
|
|
|
it under the terms of the GNU General Public License as published by
|
|
|
|
|
the Free Software Foundation; either version 2 of the License, or
|
|
|
|
|
(at your option) any later version.
|
|
|
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
|
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
|
GNU General Public License for more details.
|
|
|
|
|
|
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
|
|
|
along with this program; if not, write to the Free Software
|
|
|
|
|
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
|
|
|
-}
|
|
|
|
|
|
|
|
|
|
{- |
|
|
|
|
|
Module : Text.Pandoc.Readers.LaTeX
|
2012-01-29 23:54:00 -08:00
|
|
|
|
Copyright : Copyright (C) 2006-2012 John MacFarlane
|
|
|
|
|
License : GNU GPL, version 2 or above
|
2007-11-03 23:27:58 +00:00
|
|
|
|
|
|
|
|
|
Maintainer : John MacFarlane <jgm@berkeley.edu>
|
|
|
|
|
Stability : alpha
|
|
|
|
|
Portability : portable
|
|
|
|
|
|
|
|
|
|
Conversion of LaTeX to 'Pandoc' document.
|
|
|
|
|
-}
|
2012-01-29 23:54:00 -08:00
|
|
|
|
module Text.Pandoc.Readers.LaTeX ( readLaTeX,
|
|
|
|
|
rawLaTeXInline,
|
|
|
|
|
rawLaTeXBlock,
|
|
|
|
|
handleIncludes
|
2007-11-03 23:27:58 +00:00
|
|
|
|
) where
|
|
|
|
|
|
|
|
|
|
import Text.Pandoc.Definition
|
2010-07-04 13:43:45 -07:00
|
|
|
|
import Text.Pandoc.Shared
|
2012-07-25 11:43:56 -07:00
|
|
|
|
import Text.Pandoc.Options
|
2012-10-13 11:33:55 -07:00
|
|
|
|
import Text.Pandoc.Biblio (processBiblio)
|
2012-07-20 14:41:44 -07:00
|
|
|
|
import Text.Pandoc.Parsing hiding ((<|>), many, optional, space)
|
2012-02-04 15:56:55 -08:00
|
|
|
|
import qualified Text.Pandoc.UTF8 as UTF8
|
2012-01-29 23:54:00 -08:00
|
|
|
|
import Data.Char ( chr, ord )
|
2011-01-05 12:25:47 -08:00
|
|
|
|
import Control.Monad
|
2012-01-29 23:54:00 -08:00
|
|
|
|
import Text.Pandoc.Builder
|
2012-02-10 21:47:36 -08:00
|
|
|
|
import Data.Char (isLetter, isPunctuation, isSpace)
|
2012-01-29 23:54:00 -08:00
|
|
|
|
import Control.Applicative
|
|
|
|
|
import Data.Monoid
|
|
|
|
|
import System.FilePath (replaceExtension)
|
2012-02-04 15:56:55 -08:00
|
|
|
|
import Data.List (intercalate)
|
2012-01-29 23:54:00 -08:00
|
|
|
|
import qualified Data.Map as M
|
2012-07-24 19:28:51 -07:00
|
|
|
|
import qualified Control.Exception as E
|
2007-11-03 23:27:58 +00:00
|
|
|
|
|
|
|
|
|
-- | Parse LaTeX from string and return 'Pandoc' document.
|
2012-07-25 22:35:41 -07:00
|
|
|
|
readLaTeX :: ReaderOptions -- ^ Reader options
|
2009-10-04 22:09:23 +00:00
|
|
|
|
-> String -- ^ String to parse (assumes @'\n'@ line endings)
|
2007-11-03 23:27:58 +00:00
|
|
|
|
-> Pandoc
|
2012-07-25 22:35:41 -07:00
|
|
|
|
readLaTeX opts = readWith parseLaTeX def{ stateOptions = opts }
|
2007-11-03 23:27:58 +00:00
|
|
|
|
|
2012-01-29 23:54:00 -08:00
|
|
|
|
parseLaTeX :: LP Pandoc
|
|
|
|
|
parseLaTeX = do
|
|
|
|
|
bs <- blocks
|
|
|
|
|
eof
|
|
|
|
|
st <- getState
|
|
|
|
|
let title' = stateTitle st
|
|
|
|
|
let authors' = stateAuthors st
|
|
|
|
|
let date' = stateDate st
|
2012-10-13 11:33:55 -07:00
|
|
|
|
refs <- getOption readerReferences
|
|
|
|
|
mbsty <- getOption readerCitationStyle
|
|
|
|
|
return $ processBiblio mbsty refs
|
|
|
|
|
$ Pandoc (Meta title' authors' date') $ toList bs
|
2007-11-03 23:27:58 +00:00
|
|
|
|
|
2012-07-20 15:54:57 -07:00
|
|
|
|
type LP = Parser [Char] ParserState
|
2007-11-03 23:27:58 +00:00
|
|
|
|
|
2012-01-29 23:54:00 -08:00
|
|
|
|
anyControlSeq :: LP String
|
|
|
|
|
anyControlSeq = do
|
2007-11-03 23:27:58 +00:00
|
|
|
|
char '\\'
|
2012-01-29 23:54:00 -08:00
|
|
|
|
next <- option '\n' anyChar
|
|
|
|
|
name <- case next of
|
|
|
|
|
'\n' -> return ""
|
|
|
|
|
c | isLetter c -> (c:) <$> (many letter <* optional sp)
|
|
|
|
|
| otherwise -> return [c]
|
2007-11-03 23:27:58 +00:00
|
|
|
|
return name
|
|
|
|
|
|
2012-01-29 23:54:00 -08:00
|
|
|
|
controlSeq :: String -> LP String
|
|
|
|
|
controlSeq name = try $ do
|
|
|
|
|
char '\\'
|
|
|
|
|
case name of
|
|
|
|
|
"" -> mzero
|
|
|
|
|
[c] | not (isLetter c) -> string [c]
|
2012-04-10 18:25:18 -07:00
|
|
|
|
cs -> string cs <* notFollowedBy letter <* optional sp
|
2007-11-03 23:27:58 +00:00
|
|
|
|
return name
|
|
|
|
|
|
2012-04-10 18:56:08 -07:00
|
|
|
|
dimenarg :: LP String
|
|
|
|
|
dimenarg = try $ do
|
|
|
|
|
ch <- option "" $ string "="
|
|
|
|
|
num <- many1 digit
|
|
|
|
|
dim <- oneOfStrings ["pt","pc","in","bp","cm","mm","dd","cc","sp"]
|
|
|
|
|
return $ ch ++ num ++ dim
|
|
|
|
|
|
2012-01-29 23:54:00 -08:00
|
|
|
|
sp :: LP ()
|
|
|
|
|
sp = skipMany1 $ satisfy (\c -> c == ' ' || c == '\t')
|
|
|
|
|
<|> (try $ newline >>~ lookAhead anyChar >>~ notFollowedBy blankline)
|
|
|
|
|
|
|
|
|
|
isLowerHex :: Char -> Bool
|
|
|
|
|
isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'
|
|
|
|
|
|
|
|
|
|
tildeEscape :: LP Char
|
|
|
|
|
tildeEscape = try $ do
|
|
|
|
|
string "^^"
|
|
|
|
|
c <- satisfy (\x -> x >= '\0' && x <= '\128')
|
|
|
|
|
d <- if isLowerHex c
|
|
|
|
|
then option "" $ count 1 (satisfy isLowerHex)
|
|
|
|
|
else return ""
|
|
|
|
|
if null d
|
|
|
|
|
then case ord c of
|
|
|
|
|
x | x >= 64 && x <= 127 -> return $ chr (x - 64)
|
|
|
|
|
| otherwise -> return $ chr (x + 64)
|
|
|
|
|
else return $ chr $ read ('0':'x':c:d)
|
|
|
|
|
|
|
|
|
|
comment :: LP ()
|
|
|
|
|
comment = do
|
|
|
|
|
char '%'
|
|
|
|
|
skipMany (satisfy (/='\n'))
|
|
|
|
|
newline
|
|
|
|
|
return ()
|
|
|
|
|
|
2012-04-07 16:16:43 -07:00
|
|
|
|
bgroup :: LP ()
|
|
|
|
|
bgroup = () <$ char '{'
|
|
|
|
|
<|> () <$ controlSeq "bgroup"
|
|
|
|
|
<|> () <$ controlSeq "begingroup"
|
|
|
|
|
|
|
|
|
|
egroup :: LP ()
|
|
|
|
|
egroup = () <$ char '}'
|
|
|
|
|
<|> () <$ controlSeq "egroup"
|
|
|
|
|
<|> () <$ controlSeq "endgroup"
|
|
|
|
|
|
2012-01-29 23:54:00 -08:00
|
|
|
|
grouped :: Monoid a => LP a -> LP a
|
2012-04-07 16:16:43 -07:00
|
|
|
|
grouped parser = try $ bgroup *> (mconcat <$> manyTill parser egroup)
|
2012-01-29 23:54:00 -08:00
|
|
|
|
|
|
|
|
|
braced :: LP String
|
2012-04-07 16:16:43 -07:00
|
|
|
|
braced = bgroup *> (concat <$> manyTill
|
2012-01-29 23:54:00 -08:00
|
|
|
|
( many1 (satisfy (\c -> c /= '\\' && c /= '}' && c /= '{'))
|
|
|
|
|
<|> try (string "\\}")
|
|
|
|
|
<|> try (string "\\{")
|
2012-02-09 17:45:40 -08:00
|
|
|
|
<|> try (string "\\\\")
|
2012-01-29 23:54:00 -08:00
|
|
|
|
<|> ((\x -> "{" ++ x ++ "}") <$> braced)
|
|
|
|
|
<|> count 1 anyChar
|
2012-04-07 16:16:43 -07:00
|
|
|
|
) egroup)
|
2012-01-29 23:54:00 -08:00
|
|
|
|
|
|
|
|
|
bracketed :: Monoid a => LP a -> LP a
|
|
|
|
|
bracketed parser = try $ char '[' *> (mconcat <$> manyTill parser (char ']'))
|
|
|
|
|
|
|
|
|
|
mathDisplay :: LP String -> LP Inlines
|
|
|
|
|
mathDisplay p = displayMath <$> (try p >>= applyMacros' . trim)
|
|
|
|
|
|
|
|
|
|
mathInline :: LP String -> LP Inlines
|
|
|
|
|
mathInline p = math <$> (try p >>= applyMacros')
|
|
|
|
|
|
2012-02-07 19:40:26 -08:00
|
|
|
|
mathChars :: LP String
|
|
|
|
|
mathChars = concat <$>
|
|
|
|
|
many ( many1 (satisfy (\c -> c /= '$' && c /='\\'))
|
|
|
|
|
<|> (\c -> ['\\',c]) <$> (try $ char '\\' *> anyChar)
|
|
|
|
|
)
|
|
|
|
|
|
2012-01-29 23:54:00 -08:00
|
|
|
|
double_quote :: LP Inlines
|
|
|
|
|
double_quote = (doubleQuoted . mconcat) <$>
|
|
|
|
|
(try $ string "``" *> manyTill inline (try $ string "''"))
|
|
|
|
|
|
|
|
|
|
single_quote :: LP Inlines
|
2012-09-06 16:02:56 -07:00
|
|
|
|
single_quote = (singleQuoted . mconcat) <$>
|
|
|
|
|
(try $ char '`' *> manyTill inline (try $ char '\'' >> notFollowedBy letter))
|
2012-01-29 23:54:00 -08:00
|
|
|
|
|
|
|
|
|
inline :: LP Inlines
|
|
|
|
|
inline = (mempty <$ comment)
|
|
|
|
|
<|> (space <$ sp)
|
|
|
|
|
<|> inlineText
|
|
|
|
|
<|> inlineCommand
|
|
|
|
|
<|> grouped inline
|
|
|
|
|
<|> (char '-' *> option (str "-")
|
|
|
|
|
((char '-') *> option (str "–") (str "—" <$ char '-')))
|
|
|
|
|
<|> double_quote
|
|
|
|
|
<|> single_quote
|
2012-09-06 16:02:56 -07:00
|
|
|
|
<|> (str "“" <$ try (string "``")) -- nb. {``} won't be caught by double_quote
|
|
|
|
|
<|> (str "”" <$ try (string "''"))
|
|
|
|
|
<|> (str "‘" <$ char '`') -- nb. {`} won't be caught by single_quote
|
2012-01-29 23:54:00 -08:00
|
|
|
|
<|> (str "’" <$ char '\'')
|
|
|
|
|
<|> (str "\160" <$ char '~')
|
2012-02-07 19:40:26 -08:00
|
|
|
|
<|> (mathDisplay $ string "$$" *> mathChars <* string "$$")
|
|
|
|
|
<|> (mathInline $ char '$' *> mathChars <* char '$')
|
2012-01-29 23:54:00 -08:00
|
|
|
|
<|> (superscript <$> (char '^' *> tok))
|
|
|
|
|
<|> (subscript <$> (char '_' *> tok))
|
2012-08-08 23:18:19 -07:00
|
|
|
|
<|> (guardEnabled Ext_literate_haskell *> char '|' *> doLHSverb)
|
2012-09-06 16:02:56 -07:00
|
|
|
|
<|> (str . (:[]) <$> tildeEscape)
|
|
|
|
|
<|> (str . (:[]) <$> oneOf "[]")
|
|
|
|
|
<|> (str . (:[]) <$> oneOf "#&") -- TODO print warning?
|
2012-02-04 12:51:27 -08:00
|
|
|
|
-- <|> (str <$> count 1 (satisfy (\c -> c /= '\\' && c /='\n' && c /='}' && c /='{'))) -- eat random leftover characters
|
2012-01-29 23:54:00 -08:00
|
|
|
|
|
|
|
|
|
inlines :: LP Inlines
|
|
|
|
|
inlines = mconcat <$> many (notFollowedBy (char '}') *> inline)
|
|
|
|
|
|
|
|
|
|
block :: LP Blocks
|
|
|
|
|
block = (mempty <$ comment)
|
2012-04-11 08:52:16 -07:00
|
|
|
|
<|> (mempty <$ ((spaceChar <|> newline) *> spaces))
|
2012-01-29 23:54:00 -08:00
|
|
|
|
<|> environment
|
|
|
|
|
<|> mempty <$ macro -- TODO improve macros, make them work everywhere
|
|
|
|
|
<|> blockCommand
|
|
|
|
|
<|> paragraph
|
2012-09-06 15:28:25 -07:00
|
|
|
|
<|> grouped block
|
2012-02-04 12:51:27 -08:00
|
|
|
|
<|> (mempty <$ char '&') -- loose & in table environment
|
2012-01-29 23:54:00 -08:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
blocks :: LP Blocks
|
|
|
|
|
blocks = mconcat <$> many block
|
|
|
|
|
|
|
|
|
|
blockCommand :: LP Blocks
|
|
|
|
|
blockCommand = try $ do
|
|
|
|
|
name <- anyControlSeq
|
2012-09-09 18:27:52 -07:00
|
|
|
|
guard $ name /= "begin" && name /= "end"
|
2012-01-29 23:54:00 -08:00
|
|
|
|
star <- option "" (string "*" <* optional sp)
|
|
|
|
|
let name' = name ++ star
|
|
|
|
|
case M.lookup name' blockCommands of
|
|
|
|
|
Just p -> p
|
|
|
|
|
Nothing -> case M.lookup name blockCommands of
|
|
|
|
|
Just p -> p
|
|
|
|
|
Nothing -> mzero
|
|
|
|
|
|
|
|
|
|
inBrackets :: Inlines -> Inlines
|
|
|
|
|
inBrackets x = (str "[") <> x <> (str "]")
|
|
|
|
|
|
2012-02-04 22:28:16 -08:00
|
|
|
|
-- eat an optional argument and one or more arguments in braces
|
|
|
|
|
ignoreInlines :: String -> (String, LP Inlines)
|
|
|
|
|
ignoreInlines name = (name, doraw <|> (mempty <$ optargs))
|
2012-02-09 17:45:40 -08:00
|
|
|
|
where optargs = skipopts *> skipMany (try $ optional sp *> braced)
|
2012-02-04 22:28:16 -08:00
|
|
|
|
contseq = '\\':name
|
|
|
|
|
doraw = (rawInline "latex" . (contseq ++) . snd) <$>
|
2012-07-25 11:43:56 -07:00
|
|
|
|
(getOption readerParseRaw >>= guard >> (withRaw optargs))
|
2012-02-04 22:28:16 -08:00
|
|
|
|
|
|
|
|
|
ignoreBlocks :: String -> (String, LP Blocks)
|
|
|
|
|
ignoreBlocks name = (name, doraw <|> (mempty <$ optargs))
|
2012-02-09 17:45:40 -08:00
|
|
|
|
where optargs = skipopts *> skipMany (try $ optional sp *> braced)
|
2012-02-04 22:28:16 -08:00
|
|
|
|
contseq = '\\':name
|
|
|
|
|
doraw = (rawBlock "latex" . (contseq ++) . snd) <$>
|
2012-07-25 11:43:56 -07:00
|
|
|
|
(getOption readerParseRaw >>= guard >> (withRaw optargs))
|
2012-02-04 22:28:16 -08:00
|
|
|
|
|
2012-01-29 23:54:00 -08:00
|
|
|
|
blockCommands :: M.Map String (LP Blocks)
|
2012-02-04 22:28:16 -08:00
|
|
|
|
blockCommands = M.fromList $
|
2012-02-09 17:45:40 -08:00
|
|
|
|
[ ("par", mempty <$ skipopts)
|
|
|
|
|
, ("title", mempty <$ (skipopts *> tok >>= addTitle))
|
|
|
|
|
, ("subtitle", mempty <$ (skipopts *> tok >>= addSubtitle))
|
|
|
|
|
, ("author", mempty <$ (skipopts *> authors))
|
|
|
|
|
-- -- in letter class, temp. store address & sig as title, author
|
|
|
|
|
, ("address", mempty <$ (skipopts *> tok >>= addTitle))
|
|
|
|
|
, ("signature", mempty <$ (skipopts *> authors))
|
|
|
|
|
, ("date", mempty <$ (skipopts *> tok >>= addDate))
|
2012-02-04 22:28:16 -08:00
|
|
|
|
-- sectioning
|
2012-01-29 23:54:00 -08:00
|
|
|
|
, ("chapter", updateState (\s -> s{ stateHasChapters = True }) *> section 0)
|
|
|
|
|
, ("section", section 1)
|
|
|
|
|
, ("subsection", section 2)
|
|
|
|
|
, ("subsubsection", section 3)
|
|
|
|
|
, ("paragraph", section 4)
|
|
|
|
|
, ("subparagraph", section 5)
|
2012-02-05 09:28:56 -08:00
|
|
|
|
-- beamer slides
|
|
|
|
|
, ("frametitle", section 3)
|
|
|
|
|
, ("framesubtitle", section 4)
|
|
|
|
|
-- letters
|
2012-02-09 17:45:40 -08:00
|
|
|
|
, ("opening", (para . trimInlines) <$> (skipopts *> tok))
|
|
|
|
|
, ("closing", skipopts *> closing)
|
2012-02-05 09:28:56 -08:00
|
|
|
|
--
|
2012-02-09 17:45:40 -08:00
|
|
|
|
, ("rule", skipopts *> tok *> tok *> pure horizontalRule)
|
|
|
|
|
, ("item", skipopts *> loose_item)
|
|
|
|
|
, ("documentclass", skipopts *> braced *> preamble)
|
2012-05-22 15:38:11 -07:00
|
|
|
|
, ("centerline", (para . trimInlines) <$> (skipopts *> tok))
|
2012-02-04 22:28:16 -08:00
|
|
|
|
] ++ map ignoreBlocks
|
|
|
|
|
-- these commands will be ignored unless --parse-raw is specified,
|
|
|
|
|
-- in which case they will appear as raw latex blocks
|
|
|
|
|
[ "newcommand", "renewcommand", "newenvironment", "renewenvironment"
|
|
|
|
|
-- newcommand, etc. should be parsed by macro, but we need this
|
|
|
|
|
-- here so these aren't parsed as inline commands to ignore
|
|
|
|
|
, "special", "pdfannot", "pdfstringdef"
|
2012-02-06 12:41:34 -08:00
|
|
|
|
, "bibliography", "bibliographystyle"
|
|
|
|
|
, "maketitle", "makeindex", "makeglossary"
|
2012-02-04 22:28:16 -08:00
|
|
|
|
, "addcontentsline", "addtocontents", "addtocounter"
|
|
|
|
|
-- \ignore{} is used conventionally in literate haskell for definitions
|
|
|
|
|
-- that are to be processed by the compiler but not printed.
|
|
|
|
|
, "ignore"
|
|
|
|
|
, "hyperdef"
|
|
|
|
|
, "markboth", "markright", "markleft"
|
2012-02-04 23:19:09 -08:00
|
|
|
|
, "hspace", "vspace"
|
2012-01-29 23:54:00 -08:00
|
|
|
|
]
|
|
|
|
|
|
|
|
|
|
addTitle :: Inlines -> LP ()
|
|
|
|
|
addTitle tit = updateState (\s -> s{ stateTitle = toList tit })
|
|
|
|
|
|
|
|
|
|
addSubtitle :: Inlines -> LP ()
|
|
|
|
|
addSubtitle tit = updateState (\s -> s{ stateTitle = stateTitle s ++
|
|
|
|
|
toList (str ":" <> linebreak <> tit) })
|
|
|
|
|
|
|
|
|
|
authors :: LP ()
|
|
|
|
|
authors = try $ do
|
2011-01-06 09:34:06 -08:00
|
|
|
|
char '{'
|
2012-02-05 09:06:34 -08:00
|
|
|
|
let oneAuthor = mconcat <$>
|
2012-05-11 20:50:00 -07:00
|
|
|
|
many1 (notFollowedBy' (controlSeq "and") >>
|
|
|
|
|
(inline <|> mempty <$ blockCommand))
|
|
|
|
|
-- skip e.g. \vspace{10pt}
|
2012-01-29 23:54:00 -08:00
|
|
|
|
auths <- sepBy oneAuthor (controlSeq "and")
|
2012-02-05 09:06:34 -08:00
|
|
|
|
char '}'
|
2012-01-29 23:54:00 -08:00
|
|
|
|
updateState (\s -> s { stateAuthors = map (normalizeSpaces . toList) auths })
|
|
|
|
|
|
|
|
|
|
addDate :: Inlines -> LP ()
|
|
|
|
|
addDate dat = updateState (\s -> s{ stateDate = toList dat })
|
|
|
|
|
|
|
|
|
|
section :: Int -> LP Blocks
|
|
|
|
|
section lvl = do
|
|
|
|
|
hasChapters <- stateHasChapters `fmap` getState
|
|
|
|
|
let lvl' = if hasChapters then lvl + 1 else lvl
|
2012-02-09 17:45:40 -08:00
|
|
|
|
skipopts
|
2012-01-29 23:54:00 -08:00
|
|
|
|
contents <- grouped inline
|
|
|
|
|
return $ header lvl' contents
|
|
|
|
|
|
|
|
|
|
inlineCommand :: LP Inlines
|
|
|
|
|
inlineCommand = try $ do
|
|
|
|
|
name <- anyControlSeq
|
2012-09-09 18:21:53 -07:00
|
|
|
|
guard $ name /= "begin" && name /= "end"
|
2012-01-29 23:54:00 -08:00
|
|
|
|
guard $ not $ isBlockCommand name
|
2012-07-25 11:43:56 -07:00
|
|
|
|
parseRaw <- getOption readerParseRaw
|
2012-01-29 23:54:00 -08:00
|
|
|
|
star <- option "" (string "*")
|
|
|
|
|
let name' = name ++ star
|
2012-04-15 17:40:58 -07:00
|
|
|
|
let rawargs = withRaw (skipopts *> option "" dimenarg
|
|
|
|
|
*> many braced) >>= applyMacros' . snd
|
|
|
|
|
let raw = if parseRaw
|
|
|
|
|
then (rawInline "latex" . (('\\':name') ++)) <$> rawargs
|
|
|
|
|
else mempty <$> rawargs
|
2012-01-29 23:54:00 -08:00
|
|
|
|
case M.lookup name' inlineCommands of
|
2012-04-15 17:40:58 -07:00
|
|
|
|
Just p -> p <|> raw
|
2012-01-29 23:54:00 -08:00
|
|
|
|
Nothing -> case M.lookup name inlineCommands of
|
2012-04-15 17:40:58 -07:00
|
|
|
|
Just p -> p <|> raw
|
|
|
|
|
Nothing -> raw
|
|
|
|
|
|
|
|
|
|
unlessParseRaw :: LP ()
|
2012-07-25 11:43:56 -07:00
|
|
|
|
unlessParseRaw = getOption readerParseRaw >>= guard . not
|
2012-01-29 23:54:00 -08:00
|
|
|
|
|
|
|
|
|
isBlockCommand :: String -> Bool
|
|
|
|
|
isBlockCommand s = maybe False (const True) $ M.lookup s blockCommands
|
|
|
|
|
|
|
|
|
|
inlineCommands :: M.Map String (LP Inlines)
|
2012-02-04 22:28:16 -08:00
|
|
|
|
inlineCommands = M.fromList $
|
2012-01-29 23:54:00 -08:00
|
|
|
|
[ ("emph", emph <$> tok)
|
|
|
|
|
, ("textit", emph <$> tok)
|
|
|
|
|
, ("textsc", smallcaps <$> tok)
|
|
|
|
|
, ("sout", strikeout <$> tok)
|
|
|
|
|
, ("textsuperscript", superscript <$> tok)
|
|
|
|
|
, ("textsubscript", subscript <$> tok)
|
|
|
|
|
, ("textbackslash", lit "\\")
|
|
|
|
|
, ("backslash", lit "\\")
|
2012-09-04 23:21:15 -07:00
|
|
|
|
, ("slash", lit "/")
|
2012-01-29 23:54:00 -08:00
|
|
|
|
, ("textbf", strong <$> tok)
|
|
|
|
|
, ("ldots", lit "…")
|
|
|
|
|
, ("dots", lit "…")
|
|
|
|
|
, ("mdots", lit "…")
|
|
|
|
|
, ("sim", lit "~")
|
2012-04-15 17:40:58 -07:00
|
|
|
|
, ("label", unlessParseRaw >> (inBrackets <$> tok))
|
|
|
|
|
, ("ref", unlessParseRaw >> (inBrackets <$> tok))
|
2012-01-29 23:54:00 -08:00
|
|
|
|
, ("(", mathInline $ manyTill anyChar (try $ string "\\)"))
|
|
|
|
|
, ("[", mathDisplay $ manyTill anyChar (try $ string "\\]"))
|
|
|
|
|
, ("ensuremath", mathInline $ braced)
|
2012-02-04 22:28:16 -08:00
|
|
|
|
, ("P", lit "¶")
|
|
|
|
|
, ("S", lit "§")
|
2012-01-29 23:54:00 -08:00
|
|
|
|
, ("$", lit "$")
|
|
|
|
|
, ("%", lit "%")
|
|
|
|
|
, ("&", lit "&")
|
|
|
|
|
, ("#", lit "#")
|
|
|
|
|
, ("_", lit "_")
|
|
|
|
|
, ("{", lit "{")
|
|
|
|
|
, ("}", lit "}")
|
|
|
|
|
-- old TeX commands
|
|
|
|
|
, ("em", emph <$> inlines)
|
|
|
|
|
, ("it", emph <$> inlines)
|
|
|
|
|
, ("sl", emph <$> inlines)
|
|
|
|
|
, ("bf", strong <$> inlines)
|
|
|
|
|
, ("rm", inlines)
|
|
|
|
|
, ("itshape", emph <$> inlines)
|
|
|
|
|
, ("slshape", emph <$> inlines)
|
|
|
|
|
, ("scshape", smallcaps <$> inlines)
|
|
|
|
|
, ("bfseries", strong <$> inlines)
|
|
|
|
|
, ("/", pure mempty) -- italic correction
|
|
|
|
|
, ("aa", lit "å")
|
|
|
|
|
, ("AA", lit "Å")
|
|
|
|
|
, ("ss", lit "ß")
|
|
|
|
|
, ("o", lit "ø")
|
|
|
|
|
, ("O", lit "Ø")
|
|
|
|
|
, ("L", lit "Ł")
|
|
|
|
|
, ("l", lit "ł")
|
|
|
|
|
, ("ae", lit "æ")
|
|
|
|
|
, ("AE", lit "Æ")
|
|
|
|
|
, ("pounds", lit "£")
|
|
|
|
|
, ("euro", lit "€")
|
|
|
|
|
, ("copyright", lit "©")
|
2012-02-25 09:55:38 -08:00
|
|
|
|
, ("`", option (str "`") $ try $ tok >>= accent grave)
|
|
|
|
|
, ("'", option (str "'") $ try $ tok >>= accent acute)
|
|
|
|
|
, ("^", option (str "^") $ try $ tok >>= accent circ)
|
|
|
|
|
, ("~", option (str "~") $ try $ tok >>= accent tilde)
|
|
|
|
|
, ("\"", option (str "\"") $ try $ tok >>= accent umlaut)
|
|
|
|
|
, (".", option (str ".") $ try $ tok >>= accent dot)
|
|
|
|
|
, ("=", option (str "=") $ try $ tok >>= accent macron)
|
|
|
|
|
, ("c", option (str "c") $ try $ tok >>= accent cedilla)
|
2012-01-29 23:54:00 -08:00
|
|
|
|
, ("i", lit "i")
|
2012-02-04 20:02:00 -08:00
|
|
|
|
, ("\\", linebreak <$ (optional (bracketed inline) *> optional sp))
|
2012-01-29 23:54:00 -08:00
|
|
|
|
, (",", pure mempty)
|
|
|
|
|
, ("@", pure mempty)
|
|
|
|
|
, (" ", lit "\160")
|
2012-02-04 22:28:16 -08:00
|
|
|
|
, ("ps", pure $ str "PS." <> space)
|
2012-02-05 08:50:25 -08:00
|
|
|
|
, ("TeX", lit "TeX")
|
|
|
|
|
, ("LaTeX", lit "LaTeX")
|
2012-01-29 23:54:00 -08:00
|
|
|
|
, ("bar", lit "|")
|
|
|
|
|
, ("textless", lit "<")
|
|
|
|
|
, ("textgreater", lit ">")
|
|
|
|
|
, ("thanks", (note . mconcat) <$> (char '{' *> manyTill block (char '}')))
|
|
|
|
|
, ("footnote", (note . mconcat) <$> (char '{' *> manyTill block (char '}')))
|
|
|
|
|
, ("verb", doverb)
|
|
|
|
|
, ("lstinline", doverb)
|
|
|
|
|
, ("texttt", (code . stringify . toList) <$> tok)
|
|
|
|
|
, ("url", (unescapeURL <$> braced) >>= \url ->
|
|
|
|
|
pure (link url "" (codeWith ("",["url"],[]) url)))
|
|
|
|
|
, ("href", (unescapeURL <$> braced <* optional sp) >>= \url ->
|
|
|
|
|
tok >>= \lab ->
|
|
|
|
|
pure (link url "" lab))
|
2012-02-09 17:45:40 -08:00
|
|
|
|
, ("includegraphics", skipopts *> (unescapeURL <$> braced) >>=
|
2012-01-29 23:54:00 -08:00
|
|
|
|
(\src -> pure (image src "" (str "image"))))
|
2012-10-15 20:15:34 -07:00
|
|
|
|
, ("enquote", enquote)
|
2012-10-15 19:11:01 -07:00
|
|
|
|
, ("cite", citation "cite" AuthorInText False False)
|
|
|
|
|
, ("citep", citation "citep" NormalCitation False False)
|
|
|
|
|
, ("citep*", citation "citep*" NormalCitation False False)
|
|
|
|
|
, ("citeal", citation "citeal" NormalCitation False False)
|
|
|
|
|
, ("citealp", citation "citealp" NormalCitation False False)
|
|
|
|
|
, ("citealp*", citation "citealp*" NormalCitation False False)
|
|
|
|
|
, ("autocite", citation "autocite" NormalCitation False False)
|
|
|
|
|
, ("footcite", citation "footcite" NormalCitation False True)
|
|
|
|
|
, ("parencite", citation "parencite" NormalCitation False False)
|
|
|
|
|
, ("supercite", citation "supercite" NormalCitation False False)
|
|
|
|
|
, ("footcitetext", citation "footcitetext" NormalCitation False True)
|
|
|
|
|
, ("citeyearpar", citation "citeyearpar" SuppressAuthor False False)
|
|
|
|
|
, ("citeyear", citation "citeyear" SuppressAuthor False False)
|
|
|
|
|
, ("autocite*", citation "autocite*" SuppressAuthor False False)
|
|
|
|
|
, ("cite*", citation "cite*" SuppressAuthor False False)
|
|
|
|
|
, ("parencite*", citation "parencite*" SuppressAuthor False False)
|
|
|
|
|
, ("textcite", citation "textcite" AuthorInText False False)
|
|
|
|
|
, ("citet", citation "citet" AuthorInText False False)
|
|
|
|
|
, ("citet*", citation "citet*" AuthorInText False False)
|
|
|
|
|
, ("citealt", citation "citealt" AuthorInText False False)
|
|
|
|
|
, ("citealt*", citation "citealt*" AuthorInText False False)
|
|
|
|
|
, ("textcites", citation "textcites" AuthorInText True False)
|
|
|
|
|
, ("cites", citation "cites" NormalCitation True False)
|
|
|
|
|
, ("autocites", citation "autocites" NormalCitation True False)
|
|
|
|
|
, ("footcites", citation "footcites" NormalCitation True True)
|
|
|
|
|
, ("parencites", citation "parencites" NormalCitation True False)
|
|
|
|
|
, ("supercites", citation "supercites" NormalCitation True False)
|
|
|
|
|
, ("footcitetexts", citation "footcitetexts" NormalCitation True True)
|
|
|
|
|
, ("Autocite", citation "Autocite" NormalCitation False False)
|
|
|
|
|
, ("Footcite", citation "Footcite" NormalCitation False False)
|
|
|
|
|
, ("Parencite", citation "Parencite" NormalCitation False False)
|
|
|
|
|
, ("Supercite", citation "Supercite" NormalCitation False False)
|
|
|
|
|
, ("Footcitetext", citation "Footcitetext" NormalCitation False True)
|
|
|
|
|
, ("Citeyearpar", citation "Citeyearpar" SuppressAuthor False False)
|
|
|
|
|
, ("Citeyear", citation "Citeyear" SuppressAuthor False False)
|
|
|
|
|
, ("Autocite*", citation "Autocite*" SuppressAuthor False False)
|
|
|
|
|
, ("Cite*", citation "Cite*" SuppressAuthor False False)
|
|
|
|
|
, ("Parencite*", citation "Parencite*" SuppressAuthor False False)
|
|
|
|
|
, ("Textcite", citation "Textcite" AuthorInText False False)
|
|
|
|
|
, ("Textcites", citation "Textcites" AuthorInText True False)
|
|
|
|
|
, ("Cites", citation "Cites" NormalCitation True False)
|
|
|
|
|
, ("Autocites", citation "Autocites" NormalCitation True False)
|
|
|
|
|
, ("Footcites", citation "Footcites" NormalCitation True False)
|
|
|
|
|
, ("Parencites", citation "Parencites" NormalCitation True False)
|
|
|
|
|
, ("Supercites", citation "Supercites" NormalCitation True False)
|
|
|
|
|
, ("Footcitetexts", citation "Footcitetexts" NormalCitation True True)
|
2012-01-29 23:54:00 -08:00
|
|
|
|
, ("citetext", complexNatbibCitation NormalCitation)
|
|
|
|
|
, ("citeauthor", (try (tok *> optional sp *> controlSeq "citetext") *>
|
|
|
|
|
complexNatbibCitation AuthorInText)
|
2012-10-15 19:11:01 -07:00
|
|
|
|
<|> citation "citeauthor" AuthorInText False False)
|
2012-02-04 22:28:16 -08:00
|
|
|
|
] ++ map ignoreInlines
|
|
|
|
|
-- these commands will be ignored unless --parse-raw is specified,
|
|
|
|
|
-- in which case they will appear as raw latex blocks:
|
2012-10-11 20:56:44 -07:00
|
|
|
|
[ "noindent", "index", "nocite" ]
|
2012-01-29 23:54:00 -08:00
|
|
|
|
|
|
|
|
|
unescapeURL :: String -> String
|
|
|
|
|
unescapeURL ('\\':x:xs) | isEscapable x = x:unescapeURL xs
|
|
|
|
|
where isEscapable '%' = True
|
|
|
|
|
isEscapable '#' = True
|
|
|
|
|
isEscapable _ = False
|
|
|
|
|
unescapeURL (x:xs) = x:unescapeURL xs
|
|
|
|
|
unescapeURL [] = ""
|
|
|
|
|
|
2012-10-15 20:15:34 -07:00
|
|
|
|
enquote :: LP Inlines
|
|
|
|
|
enquote = do
|
|
|
|
|
skipopts
|
|
|
|
|
context <- stateQuoteContext <$> getState
|
|
|
|
|
if context == InDoubleQuote
|
|
|
|
|
then singleQuoted <$> withQuoteContext InSingleQuote tok
|
|
|
|
|
else doubleQuoted <$> withQuoteContext InDoubleQuote tok
|
|
|
|
|
|
2012-01-29 23:54:00 -08:00
|
|
|
|
doverb :: LP Inlines
|
|
|
|
|
doverb = do
|
|
|
|
|
marker <- anyChar
|
|
|
|
|
code <$> manyTill (satisfy (/='\n')) (char marker)
|
|
|
|
|
|
|
|
|
|
doLHSverb :: LP Inlines
|
|
|
|
|
doLHSverb = codeWith ("",["haskell"],[]) <$> manyTill (satisfy (/='\n')) (char '|')
|
|
|
|
|
|
|
|
|
|
lit :: String -> LP Inlines
|
|
|
|
|
lit = pure . str
|
|
|
|
|
|
|
|
|
|
accent :: (Char -> Char) -> Inlines -> LP Inlines
|
|
|
|
|
accent f ils =
|
|
|
|
|
case toList ils of
|
|
|
|
|
(Str (x:xs) : ys) -> return $ fromList $ (Str (f x : xs) : ys)
|
|
|
|
|
[] -> mzero
|
|
|
|
|
_ -> return ils
|
|
|
|
|
|
|
|
|
|
grave :: Char -> Char
|
|
|
|
|
grave 'A' = 'À'
|
|
|
|
|
grave 'E' = 'È'
|
|
|
|
|
grave 'I' = 'Ì'
|
|
|
|
|
grave 'O' = 'Ò'
|
|
|
|
|
grave 'U' = 'Ù'
|
|
|
|
|
grave 'a' = 'à'
|
|
|
|
|
grave 'e' = 'è'
|
|
|
|
|
grave 'i' = 'ì'
|
|
|
|
|
grave 'o' = 'ò'
|
|
|
|
|
grave 'u' = 'ù'
|
|
|
|
|
grave c = c
|
|
|
|
|
|
|
|
|
|
acute :: Char -> Char
|
|
|
|
|
acute 'A' = 'Á'
|
|
|
|
|
acute 'E' = 'É'
|
|
|
|
|
acute 'I' = 'Í'
|
|
|
|
|
acute 'O' = 'Ó'
|
|
|
|
|
acute 'U' = 'Ú'
|
2012-02-25 09:24:39 -08:00
|
|
|
|
acute 'Y' = 'Ý'
|
2012-01-29 23:54:00 -08:00
|
|
|
|
acute 'a' = 'á'
|
|
|
|
|
acute 'e' = 'é'
|
|
|
|
|
acute 'i' = 'í'
|
|
|
|
|
acute 'o' = 'ó'
|
|
|
|
|
acute 'u' = 'ú'
|
2012-02-25 09:24:39 -08:00
|
|
|
|
acute 'y' = 'ý'
|
|
|
|
|
acute 'C' = 'Ć'
|
|
|
|
|
acute 'c' = 'ć'
|
|
|
|
|
acute 'L' = 'Ĺ'
|
|
|
|
|
acute 'l' = 'ĺ'
|
|
|
|
|
acute 'N' = 'Ń'
|
|
|
|
|
acute 'n' = 'ń'
|
|
|
|
|
acute 'R' = 'Ŕ'
|
|
|
|
|
acute 'r' = 'ŕ'
|
|
|
|
|
acute 'S' = 'Ś'
|
|
|
|
|
acute 's' = 'ś'
|
|
|
|
|
acute 'Z' = 'Ź'
|
|
|
|
|
acute 'z' = 'ź'
|
2012-01-29 23:54:00 -08:00
|
|
|
|
acute c = c
|
|
|
|
|
|
|
|
|
|
circ :: Char -> Char
|
2012-02-25 09:24:39 -08:00
|
|
|
|
circ 'A' = 'Â'
|
|
|
|
|
circ 'E' = 'Ê'
|
|
|
|
|
circ 'I' = 'Î'
|
|
|
|
|
circ 'O' = 'Ô'
|
|
|
|
|
circ 'U' = 'Û'
|
|
|
|
|
circ 'a' = 'â'
|
|
|
|
|
circ 'e' = 'ê'
|
|
|
|
|
circ 'i' = 'î'
|
|
|
|
|
circ 'o' = 'ô'
|
|
|
|
|
circ 'u' = 'û'
|
|
|
|
|
circ 'C' = 'Ĉ'
|
|
|
|
|
circ 'c' = 'ĉ'
|
|
|
|
|
circ 'G' = 'Ĝ'
|
|
|
|
|
circ 'g' = 'ĝ'
|
|
|
|
|
circ 'H' = 'Ĥ'
|
|
|
|
|
circ 'h' = 'ĥ'
|
|
|
|
|
circ 'J' = 'Ĵ'
|
|
|
|
|
circ 'j' = 'ĵ'
|
|
|
|
|
circ 'S' = 'Ŝ'
|
|
|
|
|
circ 's' = 'ŝ'
|
|
|
|
|
circ 'W' = 'Ŵ'
|
|
|
|
|
circ 'w' = 'ŵ'
|
|
|
|
|
circ 'Y' = 'Ŷ'
|
|
|
|
|
circ 'y' = 'ŷ'
|
|
|
|
|
circ c = c
|
|
|
|
|
|
|
|
|
|
tilde :: Char -> Char
|
|
|
|
|
tilde 'A' = 'Ã'
|
|
|
|
|
tilde 'a' = 'ã'
|
|
|
|
|
tilde 'O' = 'Õ'
|
|
|
|
|
tilde 'o' = 'õ'
|
|
|
|
|
tilde 'I' = 'Ĩ'
|
|
|
|
|
tilde 'i' = 'ĩ'
|
|
|
|
|
tilde 'U' = 'Ũ'
|
|
|
|
|
tilde 'u' = 'ũ'
|
|
|
|
|
tilde 'N' = 'Ñ'
|
|
|
|
|
tilde 'n' = 'ñ'
|
|
|
|
|
tilde c = c
|
2012-01-29 23:54:00 -08:00
|
|
|
|
|
|
|
|
|
umlaut :: Char -> Char
|
|
|
|
|
umlaut 'A' = 'Ä'
|
|
|
|
|
umlaut 'E' = 'Ë'
|
|
|
|
|
umlaut 'I' = 'Ï'
|
|
|
|
|
umlaut 'O' = 'Ö'
|
|
|
|
|
umlaut 'U' = 'Ü'
|
|
|
|
|
umlaut 'a' = 'ä'
|
|
|
|
|
umlaut 'e' = 'ë'
|
|
|
|
|
umlaut 'i' = 'ï'
|
|
|
|
|
umlaut 'o' = 'ö'
|
|
|
|
|
umlaut 'u' = 'ü'
|
|
|
|
|
umlaut c = c
|
|
|
|
|
|
2012-02-04 19:31:01 -08:00
|
|
|
|
dot :: Char -> Char
|
|
|
|
|
dot 'C' = 'Ċ'
|
|
|
|
|
dot 'c' = 'ċ'
|
|
|
|
|
dot 'E' = 'Ė'
|
|
|
|
|
dot 'e' = 'ė'
|
|
|
|
|
dot 'G' = 'Ġ'
|
|
|
|
|
dot 'g' = 'ġ'
|
|
|
|
|
dot 'I' = 'İ'
|
|
|
|
|
dot 'Z' = 'Ż'
|
|
|
|
|
dot 'z' = 'ż'
|
|
|
|
|
dot c = c
|
|
|
|
|
|
2012-02-04 19:36:05 -08:00
|
|
|
|
macron :: Char -> Char
|
|
|
|
|
macron 'A' = 'Ā'
|
|
|
|
|
macron 'E' = 'Ē'
|
|
|
|
|
macron 'I' = 'Ī'
|
|
|
|
|
macron 'O' = 'Ō'
|
|
|
|
|
macron 'U' = 'Ū'
|
|
|
|
|
macron 'a' = 'ā'
|
|
|
|
|
macron 'e' = 'ē'
|
|
|
|
|
macron 'i' = 'ī'
|
|
|
|
|
macron 'o' = 'ō'
|
|
|
|
|
macron 'u' = 'ū'
|
|
|
|
|
macron c = c
|
|
|
|
|
|
2012-02-25 09:24:39 -08:00
|
|
|
|
cedilla :: Char -> Char
|
|
|
|
|
cedilla 'c' = 'ç'
|
|
|
|
|
cedilla 'C' = 'Ç'
|
|
|
|
|
cedilla 's' = 'ş'
|
|
|
|
|
cedilla 'S' = 'Ş'
|
|
|
|
|
cedilla c = c
|
|
|
|
|
|
2012-01-29 23:54:00 -08:00
|
|
|
|
tok :: LP Inlines
|
|
|
|
|
tok = try $ grouped inline <|> inlineCommand <|> str <$> (count 1 $ inlineChar)
|
|
|
|
|
|
|
|
|
|
opt :: LP Inlines
|
|
|
|
|
opt = bracketed inline <* optional sp
|
|
|
|
|
|
2012-02-09 17:45:40 -08:00
|
|
|
|
skipopts :: LP ()
|
|
|
|
|
skipopts = skipMany opt
|
|
|
|
|
|
2012-01-29 23:54:00 -08:00
|
|
|
|
inlineText :: LP Inlines
|
|
|
|
|
inlineText = str <$> many1 inlineChar
|
|
|
|
|
|
|
|
|
|
inlineChar :: LP Char
|
2012-09-06 16:02:56 -07:00
|
|
|
|
inlineChar = noneOf "\\$%^_&~#{}^'`-[] \t\n"
|
2012-01-29 23:54:00 -08:00
|
|
|
|
|
|
|
|
|
environment :: LP Blocks
|
|
|
|
|
environment = do
|
|
|
|
|
controlSeq "begin"
|
|
|
|
|
name <- braced
|
|
|
|
|
case M.lookup name environments of
|
2012-02-04 12:27:24 -08:00
|
|
|
|
Just p -> p <|> rawEnv name
|
|
|
|
|
Nothing -> rawEnv name
|
|
|
|
|
|
|
|
|
|
rawEnv :: String -> LP Blocks
|
|
|
|
|
rawEnv name = do
|
|
|
|
|
let addBegin x = "\\begin{" ++ name ++ "}" ++ x
|
2012-07-25 11:43:56 -07:00
|
|
|
|
parseRaw <- getOption readerParseRaw
|
2012-02-04 12:27:24 -08:00
|
|
|
|
if parseRaw
|
|
|
|
|
then (rawBlock "latex" . addBegin) <$>
|
|
|
|
|
(withRaw (env name blocks) >>= applyMacros' . snd)
|
|
|
|
|
else env name blocks
|
2012-01-29 23:54:00 -08:00
|
|
|
|
|
|
|
|
|
-- | Replace "include" commands with file contents.
|
|
|
|
|
handleIncludes :: String -> IO String
|
|
|
|
|
handleIncludes [] = return []
|
|
|
|
|
handleIncludes ('\\':xs) =
|
|
|
|
|
case runParser include defaultParserState "input" ('\\':xs) of
|
2012-07-24 19:28:51 -07:00
|
|
|
|
Right (fs, rest) -> do let getfile f = E.catch (UTF8.readFile f)
|
|
|
|
|
(\e -> let _ = (e :: E.SomeException)
|
|
|
|
|
in return "")
|
2012-02-04 15:56:55 -08:00
|
|
|
|
yss <- mapM getfile fs
|
|
|
|
|
(intercalate "\n" yss ++) `fmap`
|
|
|
|
|
handleIncludes rest
|
2012-02-04 22:28:16 -08:00
|
|
|
|
_ -> case runParser (verbCmd <|> verbatimEnv) defaultParserState
|
|
|
|
|
"input" ('\\':xs) of
|
2012-01-29 23:54:00 -08:00
|
|
|
|
Right (r, rest) -> (r ++) `fmap` handleIncludes rest
|
|
|
|
|
_ -> ('\\':) `fmap` handleIncludes xs
|
|
|
|
|
handleIncludes (x:xs) = (x:) `fmap` handleIncludes xs
|
|
|
|
|
|
2012-02-04 15:56:55 -08:00
|
|
|
|
include :: LP ([FilePath], String)
|
2012-01-29 23:54:00 -08:00
|
|
|
|
include = do
|
2012-02-04 13:01:00 -08:00
|
|
|
|
name <- controlSeq "include" <|> controlSeq "usepackage"
|
2012-02-09 17:45:40 -08:00
|
|
|
|
skipopts
|
2012-02-04 15:56:55 -08:00
|
|
|
|
fs <- (splitBy (==',')) <$> braced
|
2012-01-29 23:54:00 -08:00
|
|
|
|
rest <- getInput
|
2012-02-04 15:56:55 -08:00
|
|
|
|
let fs' = if name == "include"
|
|
|
|
|
then map (flip replaceExtension ".tex") fs
|
|
|
|
|
else map (flip replaceExtension ".sty") fs
|
|
|
|
|
return (fs', rest)
|
2012-01-29 23:54:00 -08:00
|
|
|
|
|
2012-02-04 22:28:16 -08:00
|
|
|
|
verbCmd :: LP (String, String)
|
|
|
|
|
verbCmd = do
|
|
|
|
|
(_,r) <- withRaw $ do
|
|
|
|
|
controlSeq "verb"
|
|
|
|
|
c <- anyChar
|
|
|
|
|
manyTill anyChar (char c)
|
|
|
|
|
rest <- getInput
|
|
|
|
|
return (r, rest)
|
|
|
|
|
|
2012-01-29 23:54:00 -08:00
|
|
|
|
verbatimEnv :: LP (String, String)
|
|
|
|
|
verbatimEnv = do
|
|
|
|
|
(_,r) <- withRaw $ do
|
|
|
|
|
controlSeq "begin"
|
|
|
|
|
name <- braced
|
|
|
|
|
guard $ name == "verbatim" || name == "Verbatim" ||
|
2012-02-27 11:37:54 -08:00
|
|
|
|
name == "lstlisting" || name == "minted"
|
2012-01-29 23:54:00 -08:00
|
|
|
|
verbEnv name
|
|
|
|
|
rest <- getInput
|
|
|
|
|
return (r,rest)
|
2007-11-03 23:27:58 +00:00
|
|
|
|
|
2012-07-20 15:54:57 -07:00
|
|
|
|
rawLaTeXBlock :: Parser [Char] ParserState String
|
2012-09-22 13:00:59 -07:00
|
|
|
|
rawLaTeXBlock = snd <$> try (withRaw (environment <|> blockCommand))
|
2010-07-13 19:18:58 -07:00
|
|
|
|
|
2012-07-20 15:54:57 -07:00
|
|
|
|
rawLaTeXInline :: Parser [Char] ParserState Inline
|
2012-01-29 23:54:00 -08:00
|
|
|
|
rawLaTeXInline = do
|
2012-10-11 21:21:09 -07:00
|
|
|
|
raw <- (snd <$> withRaw inlineCommand) <|> (snd <$> withRaw blockCommand)
|
|
|
|
|
RawInline "latex" <$> applyMacros' raw
|
2012-01-29 23:54:00 -08:00
|
|
|
|
|
|
|
|
|
environments :: M.Map String (LP Blocks)
|
|
|
|
|
environments = M.fromList
|
2012-02-05 08:46:04 -08:00
|
|
|
|
[ ("document", env "document" blocks <* skipMany anyChar)
|
2012-02-04 20:02:00 -08:00
|
|
|
|
, ("letter", env "letter" letter_contents)
|
2012-01-29 23:54:00 -08:00
|
|
|
|
, ("center", env "center" blocks)
|
|
|
|
|
, ("tabular", env "tabular" simpTable)
|
|
|
|
|
, ("quote", blockQuote <$> env "quote" blocks)
|
|
|
|
|
, ("quotation", blockQuote <$> env "quotation" blocks)
|
2012-02-08 14:03:55 -08:00
|
|
|
|
, ("verse", blockQuote <$> env "verse" blocks)
|
2012-01-29 23:54:00 -08:00
|
|
|
|
, ("itemize", bulletList <$> listenv "itemize" (many item))
|
|
|
|
|
, ("description", definitionList <$> listenv "description" (many descItem))
|
|
|
|
|
, ("enumerate", ordered_list)
|
2012-08-08 23:18:19 -07:00
|
|
|
|
, ("code", guardEnabled Ext_literate_haskell *>
|
2012-02-04 12:27:37 -08:00
|
|
|
|
(codeBlockWith ("",["sourceCode","literate","haskell"],[]) <$>
|
|
|
|
|
verbEnv "code"))
|
2012-01-29 23:54:00 -08:00
|
|
|
|
, ("verbatim", codeBlock <$> (verbEnv "verbatim"))
|
|
|
|
|
, ("Verbatim", codeBlock <$> (verbEnv "Verbatim"))
|
2012-03-10 12:33:55 -08:00
|
|
|
|
, ("lstlisting", codeBlock <$> (verbEnv "lstlisting"))
|
2012-02-27 11:37:54 -08:00
|
|
|
|
, ("minted", liftA2 (\l c -> codeBlockWith ("",[l],[]) c)
|
|
|
|
|
(grouped (many1 $ satisfy (/= '}'))) (verbEnv "minted"))
|
2012-09-06 16:27:01 -07:00
|
|
|
|
, ("obeylines", parseFromString
|
|
|
|
|
(para . trimInlines . mconcat <$> many inline) =<<
|
|
|
|
|
intercalate "\\\\\n" . lines <$> verbEnv "obeylines")
|
2012-01-29 23:54:00 -08:00
|
|
|
|
, ("displaymath", mathEnv Nothing "displaymath")
|
|
|
|
|
, ("equation", mathEnv Nothing "equation")
|
|
|
|
|
, ("equation*", mathEnv Nothing "equation*")
|
|
|
|
|
, ("gather", mathEnv (Just "gathered") "gather")
|
|
|
|
|
, ("gather*", mathEnv (Just "gathered") "gather*")
|
2012-02-19 21:11:07 -08:00
|
|
|
|
, ("multline", mathEnv (Just "gathered") "multline")
|
|
|
|
|
, ("multline*", mathEnv (Just "gathered") "multline*")
|
|
|
|
|
, ("eqnarray", mathEnv (Just "aligned") "eqnarray")
|
|
|
|
|
, ("eqnarray*", mathEnv (Just "aligned") "eqnarray*")
|
|
|
|
|
, ("align", mathEnv (Just "aligned") "align")
|
|
|
|
|
, ("align*", mathEnv (Just "aligned") "align*")
|
|
|
|
|
, ("alignat", mathEnv (Just "aligned") "alignat")
|
|
|
|
|
, ("alignat*", mathEnv (Just "aligned") "alignat*")
|
2012-01-29 23:54:00 -08:00
|
|
|
|
]
|
|
|
|
|
|
2012-02-04 20:02:00 -08:00
|
|
|
|
letter_contents :: LP Blocks
|
|
|
|
|
letter_contents = do
|
|
|
|
|
bs <- blocks
|
|
|
|
|
st <- getState
|
|
|
|
|
-- add signature (author) and address (title)
|
|
|
|
|
let addr = case stateTitle st of
|
|
|
|
|
[] -> mempty
|
2012-02-04 22:28:16 -08:00
|
|
|
|
x -> para $ trimInlines $ fromList x
|
|
|
|
|
updateState $ \s -> s{ stateAuthors = [], stateTitle = [] }
|
|
|
|
|
return $ addr <> bs -- sig added by \closing
|
|
|
|
|
|
|
|
|
|
closing :: LP Blocks
|
|
|
|
|
closing = do
|
|
|
|
|
contents <- tok
|
|
|
|
|
st <- getState
|
2012-02-04 20:02:00 -08:00
|
|
|
|
let sigs = case stateAuthors st of
|
|
|
|
|
[] -> mempty
|
2012-02-04 22:28:16 -08:00
|
|
|
|
xs -> para $ trimInlines $ fromList
|
|
|
|
|
$ intercalate [LineBreak] xs
|
|
|
|
|
return $ para (trimInlines contents) <> sigs
|
2012-02-04 20:02:00 -08:00
|
|
|
|
|
2012-01-29 23:54:00 -08:00
|
|
|
|
item :: LP Blocks
|
2012-02-09 17:45:40 -08:00
|
|
|
|
item = blocks *> controlSeq "item" *> skipopts *> blocks
|
2012-01-29 23:54:00 -08:00
|
|
|
|
|
|
|
|
|
loose_item :: LP Blocks
|
|
|
|
|
loose_item = do
|
|
|
|
|
ctx <- stateParserContext `fmap` getState
|
|
|
|
|
if ctx == ListItemState
|
|
|
|
|
then mzero
|
|
|
|
|
else return mempty
|
|
|
|
|
|
|
|
|
|
descItem :: LP (Inlines, [Blocks])
|
|
|
|
|
descItem = do
|
|
|
|
|
blocks -- skip blocks before item
|
|
|
|
|
controlSeq "item"
|
|
|
|
|
optional sp
|
|
|
|
|
ils <- opt
|
|
|
|
|
bs <- blocks
|
|
|
|
|
return (ils, [bs])
|
|
|
|
|
|
|
|
|
|
env :: String -> LP a -> LP a
|
2012-09-09 19:23:55 -07:00
|
|
|
|
env name p = p <*
|
|
|
|
|
(try (controlSeq "end" *> braced >>= guard . (== name))
|
|
|
|
|
<?> ("\\end{" ++ name ++ "}"))
|
2012-01-29 23:54:00 -08:00
|
|
|
|
|
|
|
|
|
listenv :: String -> LP a -> LP a
|
|
|
|
|
listenv name p = try $ do
|
|
|
|
|
oldCtx <- stateParserContext `fmap` getState
|
|
|
|
|
updateState $ \st -> st{ stateParserContext = ListItemState }
|
|
|
|
|
res <- env name p
|
|
|
|
|
updateState $ \st -> st{ stateParserContext = oldCtx }
|
|
|
|
|
return res
|
|
|
|
|
|
|
|
|
|
mathEnv :: Maybe String -> String -> LP Blocks
|
|
|
|
|
mathEnv innerEnv name = para <$> mathDisplay (inner <$> verbEnv name)
|
|
|
|
|
where inner x = case innerEnv of
|
|
|
|
|
Nothing -> x
|
|
|
|
|
Just y -> "\\begin{" ++ y ++ "}\n" ++ x ++
|
|
|
|
|
"\\end{" ++ y ++ "}"
|
|
|
|
|
|
|
|
|
|
verbEnv :: String -> LP String
|
|
|
|
|
verbEnv name = do
|
2012-02-09 17:45:40 -08:00
|
|
|
|
skipopts
|
2012-01-29 23:54:00 -08:00
|
|
|
|
optional blankline
|
|
|
|
|
let endEnv = try $ controlSeq "end" *> braced >>= guard . (== name)
|
|
|
|
|
res <- manyTill anyChar endEnv
|
|
|
|
|
return $ stripTrailingNewlines res
|
|
|
|
|
|
|
|
|
|
ordered_list :: LP Blocks
|
|
|
|
|
ordered_list = do
|
|
|
|
|
optional sp
|
|
|
|
|
(_, style, delim) <- option (1, DefaultStyle, DefaultDelim) $
|
|
|
|
|
try $ char '[' *> anyOrderedListMarker <* char ']'
|
2010-07-13 19:22:41 -07:00
|
|
|
|
spaces
|
2012-01-29 23:54:00 -08:00
|
|
|
|
optional $ try $ controlSeq "setlength" *> grouped (controlSeq "itemindent") *> braced
|
2007-11-03 23:27:58 +00:00
|
|
|
|
spaces
|
2012-01-29 23:54:00 -08:00
|
|
|
|
start <- option 1 $ try $ do controlSeq "setcounter"
|
|
|
|
|
grouped (string "enum" *> many1 (oneOf "iv"))
|
|
|
|
|
optional sp
|
|
|
|
|
num <- grouped (many1 digit)
|
|
|
|
|
spaces
|
|
|
|
|
return $ (read num + 1 :: Int)
|
|
|
|
|
bs <- listenv "enumerate" (many item)
|
|
|
|
|
return $ orderedListWith (start, style, delim) bs
|
|
|
|
|
|
|
|
|
|
paragraph :: LP Blocks
|
|
|
|
|
paragraph = do
|
|
|
|
|
x <- mconcat <$> many1 inline
|
|
|
|
|
if x == mempty
|
|
|
|
|
then return mempty
|
|
|
|
|
else return $ para $ trimInlines x
|
|
|
|
|
|
|
|
|
|
preamble :: LP Blocks
|
|
|
|
|
preamble = mempty <$> manyTill preambleBlock beginDoc
|
|
|
|
|
where beginDoc = lookAhead $ controlSeq "begin" *> string "{document}"
|
|
|
|
|
preambleBlock = (mempty <$ comment)
|
|
|
|
|
<|> (mempty <$ sp)
|
|
|
|
|
<|> (mempty <$ blanklines)
|
|
|
|
|
<|> (mempty <$ macro)
|
|
|
|
|
<|> blockCommand
|
|
|
|
|
<|> (mempty <$ anyControlSeq)
|
|
|
|
|
<|> (mempty <$ braced)
|
|
|
|
|
<|> (mempty <$ anyChar)
|
|
|
|
|
|
|
|
|
|
-------
|
|
|
|
|
|
|
|
|
|
-- citations
|
|
|
|
|
|
2012-02-10 21:47:36 -08:00
|
|
|
|
addPrefix :: [Inline] -> [Citation] -> [Citation]
|
|
|
|
|
addPrefix p (k:ks) = k {citationPrefix = p ++ citationPrefix k} : ks
|
2012-01-29 23:54:00 -08:00
|
|
|
|
addPrefix _ _ = []
|
2007-11-03 23:27:58 +00:00
|
|
|
|
|
2012-02-10 21:47:36 -08:00
|
|
|
|
addSuffix :: [Inline] -> [Citation] -> [Citation]
|
2012-01-29 23:54:00 -08:00
|
|
|
|
addSuffix s ks@(_:_) =
|
2012-02-10 21:47:36 -08:00
|
|
|
|
let k = last ks
|
|
|
|
|
s' = case s of
|
|
|
|
|
(Str (c:_):_)
|
|
|
|
|
| not (isPunctuation c || isSpace c) -> Str "," : Space : s
|
|
|
|
|
_ -> s
|
|
|
|
|
in init ks ++ [k {citationSuffix = citationSuffix k ++ s'}]
|
2012-01-29 23:54:00 -08:00
|
|
|
|
addSuffix _ _ = []
|
|
|
|
|
|
|
|
|
|
simpleCiteArgs :: LP [Citation]
|
|
|
|
|
simpleCiteArgs = try $ do
|
2012-02-10 21:47:36 -08:00
|
|
|
|
first <- optionMaybe $ toList <$> opt
|
|
|
|
|
second <- optionMaybe $ toList <$> opt
|
2012-01-29 23:54:00 -08:00
|
|
|
|
char '{'
|
|
|
|
|
keys <- manyTill citationLabel (char '}')
|
|
|
|
|
let (pre, suf) = case (first , second ) of
|
|
|
|
|
(Just s , Nothing) -> (mempty, s )
|
|
|
|
|
(Just s , Just t ) -> (s , t )
|
|
|
|
|
_ -> (mempty, mempty)
|
|
|
|
|
conv k = Citation { citationId = k
|
|
|
|
|
, citationPrefix = []
|
|
|
|
|
, citationSuffix = []
|
|
|
|
|
, citationMode = NormalCitation
|
|
|
|
|
, citationHash = 0
|
2012-10-15 19:11:01 -07:00
|
|
|
|
, citationSuppressParens = False
|
2012-01-29 23:54:00 -08:00
|
|
|
|
, citationNoteNum = 0
|
|
|
|
|
}
|
|
|
|
|
return $ addPrefix pre $ addSuffix suf $ map conv keys
|
2007-11-03 23:27:58 +00:00
|
|
|
|
|
2012-01-29 23:54:00 -08:00
|
|
|
|
citationLabel :: LP String
|
|
|
|
|
citationLabel = trim <$>
|
|
|
|
|
(many1 (satisfy $ \c -> c /=',' && c /='}') <* optional (char ',') <* optional sp)
|
2007-11-03 23:27:58 +00:00
|
|
|
|
|
2012-01-29 23:54:00 -08:00
|
|
|
|
cites :: CitationMode -> Bool -> LP [Citation]
|
|
|
|
|
cites mode multi = try $ do
|
|
|
|
|
cits <- if multi
|
|
|
|
|
then many1 simpleCiteArgs
|
|
|
|
|
else count 1 simpleCiteArgs
|
|
|
|
|
let (c:cs) = concat cits
|
|
|
|
|
return $ case mode of
|
|
|
|
|
AuthorInText -> c {citationMode = mode} : cs
|
|
|
|
|
_ -> map (\a -> a {citationMode = mode}) (c:cs)
|
2011-01-07 10:15:48 -08:00
|
|
|
|
|
2012-10-15 19:11:01 -07:00
|
|
|
|
citation :: String -> CitationMode -> Bool -> Bool -> LP Inlines
|
|
|
|
|
citation name mode multi inNote = do
|
|
|
|
|
(cs,raw) <- withRaw $ cites mode multi
|
|
|
|
|
let cs' = if inNote then map (\c -> c{ citationSuppressParens = True }) cs else cs
|
|
|
|
|
let cit = cite cs' (rawInline "latex" $ "\\" ++ name ++ raw)
|
|
|
|
|
if inNote
|
|
|
|
|
then return $ note $ para $ cit <> str "."
|
|
|
|
|
else return cit
|
2012-01-29 23:54:00 -08:00
|
|
|
|
|
|
|
|
|
complexNatbibCitation :: CitationMode -> LP Inlines
|
|
|
|
|
complexNatbibCitation mode = try $ do
|
2012-02-10 21:47:36 -08:00
|
|
|
|
let ils = (toList . trimInlines . mconcat) <$>
|
2012-01-29 23:54:00 -08:00
|
|
|
|
many (notFollowedBy (oneOf "\\};") >> inline)
|
|
|
|
|
let parseOne = try $ do
|
|
|
|
|
skipSpaces
|
|
|
|
|
pref <- ils
|
|
|
|
|
cit' <- inline -- expect a citation
|
|
|
|
|
let citlist = toList cit'
|
|
|
|
|
cits' <- case citlist of
|
|
|
|
|
[Cite cs _] -> return cs
|
|
|
|
|
_ -> mzero
|
|
|
|
|
suff <- ils
|
|
|
|
|
skipSpaces
|
|
|
|
|
optional $ char ';'
|
|
|
|
|
return $ addPrefix pref $ addSuffix suff $ cits'
|
2012-02-06 12:41:34 -08:00
|
|
|
|
(c:cits, raw) <- withRaw $ grouped parseOne
|
|
|
|
|
return $ cite (c{ citationMode = mode }:cits)
|
|
|
|
|
(rawInline "latex" $ "\\citetext" ++ raw)
|
2011-01-07 10:15:48 -08:00
|
|
|
|
|
2012-01-29 23:54:00 -08:00
|
|
|
|
-- tables
|
2011-01-07 10:15:48 -08:00
|
|
|
|
|
2012-01-29 23:54:00 -08:00
|
|
|
|
parseAligns :: LP [Alignment]
|
2011-01-07 10:15:48 -08:00
|
|
|
|
parseAligns = try $ do
|
|
|
|
|
char '{'
|
|
|
|
|
optional $ char '|'
|
2012-03-19 08:18:32 -07:00
|
|
|
|
let cAlign = AlignCenter <$ char 'c'
|
|
|
|
|
let lAlign = AlignLeft <$ char 'l'
|
|
|
|
|
let rAlign = AlignRight <$ char 'r'
|
2012-01-29 23:54:00 -08:00
|
|
|
|
let alignChar = optional sp *> (cAlign <|> lAlign <|> rAlign)
|
2011-01-07 10:15:48 -08:00
|
|
|
|
aligns' <- sepEndBy alignChar (optional $ char '|')
|
2012-01-29 23:54:00 -08:00
|
|
|
|
spaces
|
2011-01-07 10:15:48 -08:00
|
|
|
|
char '}'
|
|
|
|
|
spaces
|
|
|
|
|
return aligns'
|
|
|
|
|
|
2012-01-29 23:54:00 -08:00
|
|
|
|
hline :: LP ()
|
|
|
|
|
hline = () <$ (try $ spaces >> controlSeq "hline")
|
2011-01-07 10:15:48 -08:00
|
|
|
|
|
2012-03-19 08:18:32 -07:00
|
|
|
|
lbreak :: LP ()
|
|
|
|
|
lbreak = () <$ (try $ spaces *> controlSeq "\\")
|
|
|
|
|
|
|
|
|
|
amp :: LP ()
|
|
|
|
|
amp = () <$ (try $ spaces *> char '&')
|
|
|
|
|
|
2011-01-07 10:15:48 -08:00
|
|
|
|
parseTableRow :: Int -- ^ number of columns
|
2012-01-29 23:54:00 -08:00
|
|
|
|
-> LP [Blocks]
|
2011-01-07 10:15:48 -08:00
|
|
|
|
parseTableRow cols = try $ do
|
2012-03-19 08:18:32 -07:00
|
|
|
|
let tableCellInline = notFollowedBy (amp <|> lbreak) >> inline
|
|
|
|
|
let tableCell = (plain . trimInlines . mconcat) <$> many tableCellInline
|
|
|
|
|
cells' <- sepBy tableCell amp
|
2011-01-07 10:15:48 -08:00
|
|
|
|
guard $ length cells' == cols
|
|
|
|
|
spaces
|
|
|
|
|
return cells'
|
|
|
|
|
|
2012-01-29 23:54:00 -08:00
|
|
|
|
simpTable :: LP Blocks
|
|
|
|
|
simpTable = try $ do
|
2011-11-12 13:03:11 -08:00
|
|
|
|
spaces
|
2012-01-29 23:54:00 -08:00
|
|
|
|
aligns <- parseAligns
|
|
|
|
|
let cols = length aligns
|
|
|
|
|
optional hline
|
2012-03-19 08:18:32 -07:00
|
|
|
|
header' <- option [] $ try (parseTableRow cols <* lbreak <* hline)
|
|
|
|
|
rows <- sepEndBy (parseTableRow cols) (lbreak <* optional hline)
|
2011-07-10 19:07:40 -07:00
|
|
|
|
spaces
|
2012-01-29 23:54:00 -08:00
|
|
|
|
let header'' = if null header'
|
|
|
|
|
then replicate cols mempty
|
|
|
|
|
else header'
|
2012-02-04 12:51:27 -08:00
|
|
|
|
lookAhead $ controlSeq "end" -- make sure we're at end
|
2012-01-29 23:54:00 -08:00
|
|
|
|
return $ table mempty (zip aligns (repeat 0)) header'' rows
|
2010-04-26 23:17:34 -07:00
|
|
|
|
|