{-# 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 " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
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 Parsec Text () ([Macro], Text)
-> String -> Text -> Either ParseError ([Macro], Text)
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec Text () ([Macro], Text)
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
  ParsecT s st m ()
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
  defs <- ParsecT s st m Macro -> ParsecT s st m () -> ParsecT s st m [Macro]
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 ParsecT s st m Macro
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m Macro
pMacroDefinition ParsecT s st m ()
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
  rest <- getInput
  return (reverse defs, 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 = ParsecT s st m Macro
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m Macro
newcommand ParsecT s st m Macro
-> ParsecT s st m Macro -> ParsecT s st m Macro
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s st m Macro
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m Macro
declareMathOperator ParsecT s st m Macro
-> ParsecT s st m Macro -> ParsecT s st m Macro
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s st m Macro
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 = ParsecT s st m ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT s st m () -> ParsecT s st m () -> ParsecT s st m ()
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s st m () -> ParsecT s st m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (ParsecT s st m ()
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
comment ParsecT s st m () -> ParsecT s st m () -> ParsecT s st m ()
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s st m ()
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 = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
s Text -> Text
forall a. a -> a
id (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Maybe Text
go ((Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Macro] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Macro]
ms) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
s
  where
    -- The limit caps the number of rewriting passes, in case of a
    -- loop in the macros.
    go :: Int -> T.Text -> Maybe T.Text
    go :: Int -> Text -> Maybe Text
go Int
0 Text
_ = Maybe Text
forall a. Maybe a
Nothing
    go Int
limit Text
x =
      case [Macro] -> Text -> Maybe (Text, Bool)
applyMacrosOnce [Macro]
ms Text
x of
           Maybe (Text, Bool)
Nothing -> Maybe Text
forall a. Maybe a
Nothing
           Just (Text
y, Bool
expanded)
             | Bool
expanded  -> Int -> Text -> Maybe Text
go (Int
limit Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
y
             | Bool
otherwise -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
y  -- no macro fired: y is a fixed point

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

-- Returns the rewritten text and whether any macro was expanded.
applyMacrosOnce :: [Macro] -> T.Text -> Maybe (T.Text, Bool)
applyMacrosOnce :: [Macro] -> Text -> Maybe (Text, Bool)
applyMacrosOnce [Macro]
ms Text
s =
  -- The unconsumed rest of the input (in case a token fails to parse,
  -- e.g. on a trailing comment or backslash) is passed through
  -- unchanged rather than dropped.
  case Parsec Text Bool ([Text], Text, Bool)
-> Bool -> String -> Text -> Either ParseError ([Text], Text, Bool)
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser ((,,) ([Text] -> Text -> Bool -> ([Text], Text, Bool))
-> ParsecT Text Bool Identity [Text]
-> ParsecT
     Text Bool Identity (Text -> Bool -> ([Text], Text, Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text Bool Identity Text
-> ParsecT Text Bool Identity [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text Bool Identity Text
tok ParsecT Text Bool Identity (Text -> Bool -> ([Text], Text, Bool))
-> ParsecT Text Bool Identity Text
-> ParsecT Text Bool Identity (Bool -> ([Text], Text, Bool))
forall a b.
ParsecT Text Bool Identity (a -> b)
-> ParsecT Text Bool Identity a -> ParsecT Text Bool Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text Bool Identity Text
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput ParsecT Text Bool Identity (Bool -> ([Text], Text, Bool))
-> ParsecT Text Bool Identity Bool
-> Parsec Text Bool ([Text], Text, Bool)
forall a b.
ParsecT Text Bool Identity (a -> b)
-> ParsecT Text Bool Identity a -> ParsecT Text Bool Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Text Bool Identity Bool
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState)
         Bool
False String
"input" Text
s of
       Right ([Text]
r, Text
rest, Bool
expanded) -> (Text, Bool) -> Maybe (Text, Bool)
forall a. a -> Maybe a
Just ([Text] -> Text
T.concat [Text]
r Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rest, Bool
expanded)
       Left ParseError
_  -> Maybe (Text, Bool)
forall a. Maybe a
Nothing
    where tok :: ParsecT Text Bool Identity Text
tok = ParsecT Text Bool Identity Text -> ParsecT Text Bool Identity Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text Bool Identity Text
 -> ParsecT Text Bool Identity Text)
-> ParsecT Text Bool Identity Text
-> ParsecT Text Bool Identity Text
forall a b. (a -> b) -> a -> b
$ do
                  ParsecT Text Bool Identity ()
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
skipComment
                  [ParsecT Text Bool Identity Text]
-> ParsecT Text Bool Identity Text
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ [ParsecT Text Bool Identity Text]
-> ParsecT Text Bool Identity Text
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ((Macro -> ParsecT Text Bool Identity Text)
-> [Macro] -> [ParsecT Text Bool Identity Text]
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)
                             ParsecT Text Bool Identity Text
-> ParsecT Text Bool Identity () -> ParsecT Text Bool Identity Text
forall a b.
ParsecT Text Bool Identity a
-> ParsecT Text Bool Identity b -> ParsecT Text Bool Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Bool -> ParsecT Text Bool Identity ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
putState Bool
True
                         , String -> Text
T.pack (String -> Text)
-> ParsecT Text Bool Identity String
-> ParsecT Text Bool Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text Bool Identity String
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
ctrlseq
                           -- Macros only match at '\\' and comments
                           -- only at '%', so anything else can be
                           -- consumed as a single chunk.
                         , String -> Text
T.pack (String -> Text)
-> ParsecT Text Bool Identity String
-> ParsecT Text Bool Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text Bool Identity Char
-> ParsecT Text Bool Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> ParsecT Text Bool Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\\%")
                         , String -> Text
T.pack (String -> Text)
-> ParsecT Text Bool Identity String
-> ParsecT Text Bool Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ParsecT Text Bool Identity Char
-> ParsecT Text Bool Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
1 ParsecT Text Bool Identity Char
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
          Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
          res <- ParsecT s st m Char -> ParsecT s st m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT s st m String
-> ParsecT s st m String -> ParsecT s st m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int -> ParsecT s st m Char -> ParsecT s st m String
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
1 ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
          return $ '\\' : 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 = ParsecT s st m Macro -> ParsecT s st m Macro
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m Macro -> ParsecT s st m Macro)
-> ParsecT s st m Macro -> ParsecT s st m Macro
forall a b. (a -> b) -> a -> b
$ do
  Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
  -- we ignore differences between these so far:
  ParsecT s st m String -> ParsecT s st m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT s st m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"newcommand")
    ParsecT s st m String
-> ParsecT s st m String -> ParsecT s st m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s st m String -> ParsecT s st m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT s st m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"renewcommand")
    ParsecT s st m String
-> ParsecT s st m String -> ParsecT s st m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT s st m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"providecommand"
  ParsecT s st m Char -> ParsecT s st m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'*')
  ParsecT s st m ()
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
  name <- ParsecT s st m String
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
inbraces ParsecT s st m String
-> ParsecT s st m String -> ParsecT s st m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s st m String
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
ctrlseq
  guard (take 1 name == "\\")
  let name' = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
name
  numargs <- numArgs
  pSkipSpaceComments
  optarg <- if numargs > 0
               then optArg
               else return Nothing
  let numargs' = case Maybe String
optarg of
                   Just String
_  -> Int
numargs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                   Maybe String
Nothing -> Int
numargs
  pSkipSpaceComments
  body <- inbraces <|> ctrlseq
  let defn = String
"\\newcommand{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}" String -> ShowS
forall a. [a] -> [a] -> [a]
++
             (if Int
numargs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then (String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
numargs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]") else String
"") String -> ShowS
forall a. [a] -> [a] -> [a]
++
             case Maybe String
optarg of { Maybe String
Nothing -> String
""; Just String
x -> String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"} String -> ShowS
forall a. [a] -> [a] -> [a]
++
             String
"{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
body String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"
  return $ Macro (T.pack defn) $ fmap T.pack $ try $ do
    char '\\'
    string name'
    when (all isLetter name') $
      notFollowedBy letter
    pSkipSpaceComments
    opt <- case optarg of
                Maybe String
Nothing  -> Maybe String -> ParsecT s st m (Maybe String)
forall a. a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
                Just String
_   -> (Maybe String -> Maybe String)
-> ParsecT s st m (Maybe String) -> ParsecT s st m (Maybe String)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe String
optarg) ParsecT s st m (Maybe String)
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m (Maybe String)
optArg
    args <- count numargs' (pSkipSpaceComments >>
                  (inbraces <|> ctrlseq <|> count 1 anyChar))
    let args' = case Maybe String
opt of
                     Just String
x  -> String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args
                     Maybe String
Nothing -> [String]
args
    return $ apply args' $ "{" ++ body ++ "}"

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

-- | 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 = ParsecT s st m Macro -> ParsecT s st m Macro
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m Macro -> ParsecT s st m Macro)
-> ParsecT s st m Macro -> ParsecT s st m Macro
forall a b. (a -> b) -> a -> b
$ do
  String -> ParsecT s st m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\DeclareMathOperator"
  ParsecT s st m ()
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
  star <- String -> ParsecT s st m String -> ParsecT s st m String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option String
"" (String -> ParsecT s st m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"*")
  pSkipSpaceComments
  name <- inbraces <|> ctrlseq
  guard (take 1 name == "\\")
  let name' = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
name
  pSkipSpaceComments
  body <- inbraces <|> ctrlseq
  let defn = String
"\\DeclareMathOperator" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
star String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}" String -> ShowS
forall a. [a] -> [a] -> [a]
++
             String
"{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
body String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"
  return $ Macro (T.pack defn) $ fmap T.pack $ try $ do
    char '\\'
    string name'
    when (all isLetter name') $
      notFollowedBy letter
    pSkipSpaceComments
    return $ "\\operatorname" ++ star ++ "{" ++ body ++ "}"


apply :: [String] -> String -> String
apply :: [String] -> ShowS
apply [String]
args (Char
'#':Char
d:String
xs) | Char -> Bool
isDigit Char
d, Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'0' =
  let argnum :: Int
argnum = String -> Int
forall a. Read a => String -> a
read [Char
d]
  in  if [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
args Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
argnum
         then [String]
args [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! (Int
argnum Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> ShowS
apply [String]
args String
xs
         else Char
'#' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
d Char -> ShowS
forall a. a -> [a] -> [a]
: [String] -> ShowS
apply [String]
args String
xs
apply [String]
args (Char
'\\':Char
'#':String
xs) = Char
'\\'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'#' Char -> ShowS
forall a. a -> [a] -> [a]
: [String] -> ShowS
apply [String]
args String
xs
apply [String]
args (Char
x:String
xs) = Char
x Char -> ShowS
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 = ParsecT s st m () -> ParsecT s st m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT s st m ()
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
  Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'%'
  ParsecT s st m Char -> ParsecT s st m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (ParsecT s st m Char -> ParsecT s st m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline ParsecT s st m () -> ParsecT s st m Char -> ParsecT s st m Char
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar)
  ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
  () -> ParsecT s st m ()
forall a. a -> ParsecT s st m a
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 = Int -> ParsecT s st m Int -> ParsecT s st m Int
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Int
0 (ParsecT s st m Int -> ParsecT s st m Int)
-> ParsecT s st m Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ ParsecT s st m Int -> ParsecT s st m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m Int -> ParsecT s st m Int)
-> ParsecT s st m Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ do
  ParsecT s st m ()
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
  Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'['
  ParsecT s st m ()
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
  n <- ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
  pSkipSpaceComments
  char ']'
  return $ read [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 = Maybe String
-> ParsecT s st m (Maybe String) -> ParsecT s st m (Maybe String)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Maybe String
forall a. Maybe a
Nothing (ParsecT s st m (Maybe String) -> ParsecT s st m (Maybe String))
-> ParsecT s st m (Maybe String) -> ParsecT s st m (Maybe String)
forall a b. (a -> b) -> a -> b
$ ((String -> Maybe String)
-> ParsecT s st m String -> ParsecT s st m (Maybe String)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> Maybe String
forall a. a -> Maybe a
Just (ParsecT s st m String -> ParsecT s st m (Maybe String))
-> ParsecT s st m String -> ParsecT s st m (Maybe String)
forall a b. (a -> b) -> a -> b
$ ParsecT s st m String
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 = ParsecT s st m String -> ParsecT s st m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m String -> ParsecT s st m String)
-> ParsecT s st m String -> ParsecT s st m String
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' ParsecT s st m Char -> ParsecT s st m Char -> ParsecT s st m Char
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
xs ParsecT s st m Char
-> (Char -> ParsecT s st m String) -> ParsecT s st m String
forall a b.
ParsecT s st m a -> (a -> ParsecT s st m b) -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
x -> String -> ParsecT s st m String
forall a. a -> ParsecT s st m a
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 = ParsecT s st m String -> ParsecT s st m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m String -> ParsecT s st m String)
-> ParsecT s st m String -> ParsecT s st m String
forall a b. (a -> b) -> a -> b
$ do
  Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'['
  ParsecT s st m ()
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
  res <- ParsecT s st m String
-> ParsecT s st m Char -> ParsecT s st m [String]
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 (ParsecT s st m ()
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
skipComment ParsecT s st m () -> ParsecT s st m String -> ParsecT s st m String
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String -> ParsecT s st m String
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
String -> ParsecT s st m String
escaped String
"[]" ParsecT s st m String
-> ParsecT s st m String -> ParsecT s st m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int -> ParsecT s st m Char -> ParsecT s st m String
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
1 ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar))
          (ParsecT s st m Char -> ParsecT s st m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m Char -> ParsecT s st m Char)
-> ParsecT s st m Char -> ParsecT s st m Char
forall a b. (a -> b) -> a -> b
$ ParsecT s st m ()
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments ParsecT s st m () -> ParsecT s st m Char -> ParsecT s st m Char
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']')
  return $ concat 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 = ParsecT s st m String -> ParsecT s st m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m String -> ParsecT s st m String)
-> ParsecT s st m String -> ParsecT s st m String
forall a b. (a -> b) -> a -> b
$ do
  Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{'
  res <- ParsecT s st m String
-> ParsecT s st m Char -> ParsecT s st m [String]
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 (ParsecT s st m ()
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
skipComment ParsecT s st m () -> ParsecT s st m String -> ParsecT s st m String
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
            (ParsecT s st m String
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
inbraces' ParsecT s st m String
-> ParsecT s st m String -> ParsecT s st m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT s st m String
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
String -> ParsecT s st m String
escaped String
"{}" ParsecT s st m String
-> ParsecT s st m String -> ParsecT s st m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Int -> ParsecT s st m Char -> ParsecT s st m String
forall s (m :: * -> *) t u a.
Stream s m t =>
Int -> ParsecT s u m a -> ParsecT s u m [a]
count Int
1 ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar))
    (ParsecT s st m Char -> ParsecT s st m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m Char -> ParsecT s st m Char)
-> ParsecT s st m Char -> ParsecT s st m Char
forall a b. (a -> b) -> a -> b
$ ParsecT s st m ()
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
skipComment ParsecT s st m () -> ParsecT s st m Char -> ParsecT s st m Char
forall a b.
ParsecT s st m a -> ParsecT s st m b -> ParsecT s st m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT s st m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}')
  return $ concat 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
  res <- ParsecT s st m String
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
inbraces
  return $ '{' : (res ++ "}")