{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-
Copyright (C) 2010 John MacFarlane <jgm@berkeley.edu>

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
-}

{- | Functions for parsing LaTeX macro definitions and applying macros
 to LateX expressions.
-}

module Text.TeXMath.Readers.TeX.Macros
                           ( Macro
                           , parseMacroDefinitions
                           , pMacroDefinition
                           , applyMacros
                           )
where

import Data.Char (isDigit, isLetter)
import qualified Data.Text as T
import Control.Monad
import Text.Parsec

data Macro = Macro { Macro -> Text
macroDefinition :: T.Text
                   , Macro
-> forall st (m :: * -> *) s.
   Stream s m Char =>
   ParsecT s st m Text
macroParser     :: forall st m s . Stream s m Char =>
                          ParsecT s st m T.Text }

instance Show Macro where
  show :: Macro -> String
show Macro
m = String
"Macro " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Macro -> Text
macroDefinition Macro
m)

-- | Parses a string for a list of macro definitions, optionally
-- separated and ended by spaces and TeX comments.  Returns
-- the list of macros (which may be empty) and the unparsed
-- portion of the input string.
parseMacroDefinitions :: T.Text -> ([Macro], T.Text)
parseMacroDefinitions :: Text -> ([Macro], Text)
parseMacroDefinitions Text
s =
  case forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ([Macro], s)
pMacroDefinitions String
"input" Text
s of
       Left ParseError
_       -> ([], Text
s)
       Right ([Macro], Text)
res    -> ([Macro], Text)
res

-- | Parses one or more macro definitions separated by comments & space.
-- Return list of macros parsed + remainder of string.
pMacroDefinitions :: (Monad m, Stream s m Char)
                  => ParsecT s st m ([Macro], s)
pMacroDefinitions :: forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ([Macro], s)
pMacroDefinitions = do
  forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
  [Macro]
defs <- forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepEndBy forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m Macro
pMacroDefinition forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
  s
rest <- forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [a] -> [a]
reverse [Macro]
defs, s
rest)  -- reversed so later macros shadow earlier

-- | Parses a @\\newcommand@ or @\\renewcommand@ macro definition and
-- returns a 'Macro'.
pMacroDefinition :: (Monad m, Stream s m Char)
                 => ParsecT s st m Macro
pMacroDefinition :: forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m Macro
pMacroDefinition = forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m Macro
newcommand forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m Macro
declareMathOperator forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m Macro
newenvironment

-- | Skip whitespace and comments.
pSkipSpaceComments :: (Monad m, Stream s m Char)
                   => ParsecT s st m ()
pSkipSpaceComments :: forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments = forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
comment forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces)

-- | Applies a list of macros to a string recursively until a fixed
-- point is reached.  If there are several macros in the list with the
-- same name, earlier ones will shadow later ones.
applyMacros :: [Macro] -> T.Text -> T.Text
applyMacros :: [Macro] -> Text -> Text
applyMacros [] Text
s = Text
s
applyMacros [Macro]
ms Text
s =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
s forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a. Eq a => Int -> (a -> Maybe a) -> a -> Maybe a
iterateToFixedPoint ((Int
2 forall a. Num a => a -> a -> a
* forall (t :: * -> *) a. Foldable t => t a -> Int
length [Macro]
ms) forall a. Num a => a -> a -> a
+ Int
1)
    ([Macro] -> Text -> Maybe Text
applyMacrosOnce [Macro]
ms) Text
s

------------------------------------------------------------------------------

iterateToFixedPoint :: Eq a => Int -> (a -> Maybe a) -> a -> Maybe a
iterateToFixedPoint :: forall a. Eq a => Int -> (a -> Maybe a) -> a -> Maybe a
iterateToFixedPoint Int
0     a -> Maybe a
_ a
_ = forall a. Maybe a
Nothing
  -- Macro application did not terminate in a reasonable time, possibly
  -- because of a loop in the macro.
iterateToFixedPoint Int
limit a -> Maybe a
f a
x =
  case a -> Maybe a
f a
x of
       Maybe a
Nothing       -> forall a. Maybe a
Nothing
       Just a
y
         | a
y forall a. Eq a => a -> a -> Bool
== a
x    -> forall a. a -> Maybe a
Just a
y
         | Bool
otherwise -> forall a. Eq a => Int -> (a -> Maybe a) -> a -> Maybe a
iterateToFixedPoint (Int
limit forall a. Num a => a -> a -> a
- Int
1) a -> Maybe a
f a
y

applyMacrosOnce :: [Macro] -> T.Text -> Maybe T.Text
applyMacrosOnce :: [Macro] -> Text -> Maybe Text
applyMacrosOnce [Macro]
ms Text
s =
  case forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall {u}. ParsecT Text u Identity Text
tok) String
"input" Text
s of
       Right [Text]
r -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text]
r
       Left ParseError
_  -> forall a. Maybe a
Nothing
    where tok :: ParsecT Text u Identity Text
tok = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
                  forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
skipComment
                  forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice (forall a b. (a -> b) -> [a] -> [b]
map (\Macro
m -> Macro
-> forall st (m :: * -> *) s.
   Stream s m Char =>
   ParsecT s st m Text
macroParser Macro
m) [Macro]
ms)
                         , String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
ctrlseq
                         , String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ]

ctrlseq :: (Monad m, Stream s m Char)
        => ParsecT s st m String
ctrlseq :: forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
ctrlseq = do
          forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
          String
res <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Char
'\\' forall a. a -> [a] -> [a]
: String
res

newcommand :: (Monad m, Stream s m Char)
           => ParsecT s st m Macro
newcommand :: forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m Macro
newcommand = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
  -- we ignore differences between these so far:
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"newcommand")
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"renewcommand")
    forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"providecommand"
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*')
  forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
  String
name <- forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
inbraces forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
ctrlseq
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall a. Int -> [a] -> [a]
take Int
1 String
name forall a. Eq a => a -> a -> Bool
== String
"\\")
  let name' :: String
name' = forall a. Int -> [a] -> [a]
drop Int
1 String
name
  Int
numargs <- forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m Int
numArgs
  forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
  Maybe String
optarg <- if Int
numargs forall a. Ord a => a -> a -> Bool
> Int
0
               then forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m (Maybe String)
optArg
               else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
  let numargs' :: Int
numargs' = case Maybe String
optarg of
                   Just String
_  -> Int
numargs forall a. Num a => a -> a -> a
- Int
1
                   Maybe String
Nothing -> Int
numargs
  forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
  String
body <- forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
inbraces forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
ctrlseq
  let defn :: String
defn = String
"\\newcommand{" forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
"}" forall a. [a] -> [a] -> [a]
++
             (if Int
numargs forall a. Ord a => a -> a -> Bool
> Int
0 then (String
"[" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
numargs forall a. [a] -> [a] -> [a]
++ String
"]") else String
"") forall a. [a] -> [a] -> [a]
++
             case Maybe String
optarg of { Maybe String
Nothing -> String
""; Just String
x -> String
"[" forall a. [a] -> [a] -> [a]
++ String
x forall a. [a] -> [a] -> [a]
++ String
"]"} forall a. [a] -> [a] -> [a]
++
             String
"{" forall a. [a] -> [a] -> [a]
++ String
body forall a. [a] -> [a] -> [a]
++ String
"}"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
-> (forall st (m :: * -> *) s.
    Stream s m Char =>
    ParsecT s st m Text)
-> Macro
Macro (String -> Text
T.pack String
defn) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
    forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
    forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
name'
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isLetter String
name') forall a b. (a -> b) -> a -> b
$
      forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
    forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
    Maybe String
opt <- case Maybe String
optarg of
                Maybe String
Nothing  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                Just String
_   -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe String
optarg) forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m (Maybe String)
optArg
    [String]
args <- forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
numargs' (forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  (forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
inbraces forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
ctrlseq forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar))
    let args' :: [String]
args' = case Maybe String
opt of
                     Just String
x  -> String
x forall a. a -> [a] -> [a]
: [String]
args
                     Maybe String
Nothing -> [String]
args
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [String] -> ShowS
apply [String]
args' forall a b. (a -> b) -> a -> b
$ String
"{" forall a. [a] -> [a] -> [a]
++ String
body forall a. [a] -> [a] -> [a]
++ String
"}"

newenvironment :: (Monad m, Stream s m Char)
               => ParsecT s st m Macro
newenvironment :: forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m Macro
newenvironment = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
  -- we ignore differences between these so far:
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"re")
  forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"newenvironment"
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*')
  forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
  String
name <- forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
inbraces forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
ctrlseq
  Int
numargs <- forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m Int
numArgs
  forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
  Maybe String
optarg <- if Int
numargs forall a. Ord a => a -> a -> Bool
> Int
0
               then forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m (Maybe String)
optArg forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
               else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
  let numargs' :: Int
numargs' = case Maybe String
optarg of
                   Just String
_  -> Int
numargs forall a. Num a => a -> a -> a
- Int
1
                   Maybe String
Nothing -> Int
numargs
  String
opener <- forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
inbraces forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
ctrlseq
  forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
  String
closer <- forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
inbraces forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
ctrlseq
  let defn :: String
defn = String
"\\newenvironment{" forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
"}" forall a. [a] -> [a] -> [a]
++
             (if Int
numargs forall a. Ord a => a -> a -> Bool
> Int
0 then (String
"[" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
numargs forall a. [a] -> [a] -> [a]
++ String
"]") else String
"") forall a. [a] -> [a] -> [a]
++
             case Maybe String
optarg of { Maybe String
Nothing -> String
""; Just String
x -> String
"[" forall a. [a] -> [a] -> [a]
++ String
x forall a. [a] -> [a] -> [a]
++ String
"]"} forall a. [a] -> [a] -> [a]
++
             String
"%\n{" forall a. [a] -> [a] -> [a]
++ String
opener forall a. [a] -> [a] -> [a]
++ String
"}%\n" forall a. [a] -> [a] -> [a]
++ String
"{" forall a. [a] -> [a] -> [a]
++ String
closer forall a. [a] -> [a] -> [a]
++ String
"}"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
-> (forall st (m :: * -> *) s.
    Stream s m Char =>
    ParsecT s st m Text)
-> Macro
Macro (String -> Text
T.pack String
defn) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
    forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\begin"
    forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
    forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{'
    forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
name
    forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
    forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}'
    Maybe String
opt <- case Maybe String
optarg of
                Maybe String
Nothing  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                Just String
_   -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe String
optarg) forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m (Maybe String)
optArg
    [String]
args <- forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
numargs' (forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  (forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
inbraces forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
ctrlseq forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar))
    let args' :: [String]
args' = case Maybe String
opt of
                     Just String
x  -> String
x forall a. a -> [a] -> [a]
: [String]
args
                     Maybe String
Nothing -> [String]
args
    let ender :: ParsecT s u m Char
ender = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
                      forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\end"
                      forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
                      forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{'
                      forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
name
                      forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}'
    String
body <- forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
manyTill forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar forall {u}. ParsecT s u m Char
ender
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [String] -> ShowS
apply [String]
args'
           forall a b. (a -> b) -> a -> b
$ String
opener forall a. [a] -> [a] -> [a]
++ String
body forall a. [a] -> [a] -> [a]
++ String
closer

-- | Parser for \DeclareMathOperator(*) command.
declareMathOperator :: (Monad m, Stream s m Char)
                    => ParsecT s st m Macro
declareMathOperator :: forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m Macro
declareMathOperator = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\DeclareMathOperator"
  forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
  String
star <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"*")
  forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
  String
name <- forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
inbraces forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
ctrlseq
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall a. Int -> [a] -> [a]
take Int
1 String
name forall a. Eq a => a -> a -> Bool
== String
"\\")
  let name' :: String
name' = forall a. Int -> [a] -> [a]
drop Int
1 String
name
  forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
  String
body <- forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
inbraces forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
ctrlseq
  let defn :: String
defn = String
"\\DeclareMathOperator" forall a. [a] -> [a] -> [a]
++ String
star forall a. [a] -> [a] -> [a]
++ String
"{" forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
"}" forall a. [a] -> [a] -> [a]
++
             String
"{" forall a. [a] -> [a] -> [a]
++ String
body forall a. [a] -> [a] -> [a]
++ String
"}"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
-> (forall st (m :: * -> *) s.
    Stream s m Char =>
    ParsecT s st m Text)
-> Macro
Macro (String -> Text
T.pack String
defn) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
    forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
    forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
name'
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isLetter String
name') forall a b. (a -> b) -> a -> b
$
      forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter
    forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
"\\operatorname" forall a. [a] -> [a] -> [a]
++ String
star forall a. [a] -> [a] -> [a]
++ String
"{" forall a. [a] -> [a] -> [a]
++ String
body forall a. [a] -> [a] -> [a]
++ String
"}"


apply :: [String] -> String -> String
apply :: [String] -> ShowS
apply [String]
args (Char
'#':Char
d:String
xs) | Char -> Bool
isDigit Char
d, Char
d forall a. Eq a => a -> a -> Bool
/= Char
'0' =
  let argnum :: Int
argnum = forall a. Read a => String -> a
read [Char
d]
  in  if forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
args forall a. Ord a => a -> a -> Bool
>= Int
argnum
         then [String]
args forall a. [a] -> Int -> a
!! (Int
argnum forall a. Num a => a -> a -> a
- Int
1) forall a. [a] -> [a] -> [a]
++ [String] -> ShowS
apply [String]
args String
xs
         else Char
'#' forall a. a -> [a] -> [a]
: Char
d forall a. a -> [a] -> [a]
: [String] -> ShowS
apply [String]
args String
xs
apply [String]
args (Char
'\\':Char
'#':String
xs) = Char
'\\'forall a. a -> [a] -> [a]
:Char
'#' forall a. a -> [a] -> [a]
: [String] -> ShowS
apply [String]
args String
xs
apply [String]
args (Char
x:String
xs) = Char
x forall a. a -> [a] -> [a]
: [String] -> ShowS
apply [String]
args String
xs
apply [String]
_ String
"" = String
""

skipComment :: (Monad m, Stream s m Char)
            => ParsecT s st m ()
skipComment :: forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
skipComment = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
comment

comment :: (Monad m, Stream s m Char)
        => ParsecT s st m ()
comment :: forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
comment = do
  forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'%'
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar)
  forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
  forall (m :: * -> *) a. Monad m => a -> m a
return ()

numArgs :: (Monad m, Stream s m Char)
        => ParsecT s st m Int
numArgs :: forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m Int
numArgs = forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
  forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'['
  forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
  Char
n <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
  forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
  forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Read a => String -> a
read [Char
n]

optArg :: (Monad m, Stream s m Char)
       => ParsecT s st m (Maybe String)
optArg :: forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m (Maybe String)
optArg = forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
inBrackets)

escaped :: (Monad m, Stream s m Char)
         => String -> ParsecT s st m String
escaped :: forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
String -> ParsecT s st m String
escaped String
xs = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
xs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
x -> forall (m :: * -> *) a. Monad m => a -> m a
return [Char
'\\',Char
x]

inBrackets :: (Monad m, Stream s m Char)
           => ParsecT s st m String
inBrackets :: forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
inBrackets = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'['
  forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
  [String]
res <- forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
manyTill (forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
skipComment forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
String -> ParsecT s st m String
escaped String
"[]" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar))
          (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']')
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
res

inbraces :: (Monad m, Stream s m Char)
         => ParsecT s st m String
inbraces :: forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
inbraces = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{'
  [String]
res <- forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
manyTill (forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
skipComment forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
            (forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
inbraces' forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
String -> ParsecT s st m String
escaped String
"{}"))
    (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
skipComment forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}')
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
res

inbraces' :: (Monad m, Stream s m Char)
          => ParsecT s st m String
inbraces' :: forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
inbraces' = do
  String
res <- forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
inbraces
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Char
'{' forall a. a -> [a] -> [a]
: (String
res forall a. [a] -> [a] -> [a]
++ String
"}")