{-# 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
import Control.Applicative ((<*))

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 :: 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
  [Macro]
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
  s
rest <- ParsecT s st m s
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  ([Macro], s) -> ParsecT s st m ([Macro], s)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Macro] -> [Macro]
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 :: 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 :: 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 (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 (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) -> Text -> Maybe Text
forall a. Eq a => Int -> (a -> Maybe a) -> a -> Maybe a
iterateToFixedPoint ((Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Macro] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Macro]
ms) Int -> Int -> Int
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 :: Int -> (a -> Maybe a) -> a -> Maybe a
iterateToFixedPoint Int
0     a -> Maybe a
_ a
_ = Maybe 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       -> Maybe a
forall a. Maybe a
Nothing
       Just a
y
         | a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x    -> a -> Maybe a
forall a. a -> Maybe a
Just a
y
         | Bool
otherwise -> Int -> (a -> Maybe a) -> a -> Maybe a
forall a. Eq a => Int -> (a -> Maybe a) -> a -> Maybe a
iterateToFixedPoint (Int
limit Int -> Int -> Int
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 Parsec Text () [Text] -> String -> Text -> Either ParseError [Text]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (ParsecT Text () Identity Text -> Parsec Text () [Text]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text () Identity Text
forall u. ParsecT Text u Identity Text
tok) String
"input" Text
s of
       Right [Text]
r -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text]
r
       Left ParseError
_  -> Maybe Text
forall a. Maybe a
Nothing
    where tok :: ParsecT Text u Identity Text
tok = ParsecT Text u Identity Text -> ParsecT Text u Identity Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text u Identity Text -> ParsecT Text u Identity Text)
-> ParsecT Text u Identity Text -> ParsecT Text u Identity Text
forall a b. (a -> b) -> a -> b
$ do
                  ParsecT Text u Identity ()
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
skipComment
                  [ParsecT Text u Identity Text] -> ParsecT Text u 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 u Identity Text] -> ParsecT Text u 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 u Identity Text)
-> [Macro] -> [ParsecT Text u 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)
                         , String -> Text
T.pack (String -> Text)
-> ParsecT Text u Identity String -> ParsecT Text u Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text u Identity String
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
ctrlseq
                         , String -> Text
T.pack (String -> Text)
-> ParsecT Text u Identity String -> ParsecT Text u Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ParsecT Text u Identity Char -> ParsecT Text u 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 u 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 :: 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
'\\'
          String
res <- ParsecT s st m Char -> ParsecT s st m String
forall s (m :: * -> *) t u a.
Stream s m t =>
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
          String -> ParsecT s st m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT s st m String)
-> String -> ParsecT s st m String
forall a b. (a -> b) -> a -> b
$ Char
'\\' Char -> ShowS
forall a. a -> [a] -> [a]
: String
res

newcommand :: (Monad m, Stream s m Char)
           => ParsecT s st m Macro
newcommand :: 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
  String
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
  Bool -> ParsecT s st m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
1 String
name String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"\\")
  let name' :: String
name' = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
name
  Int
numargs <- ParsecT s st m Int
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m Int
numArgs
  ParsecT s st m ()
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
  Maybe String
optarg <- if Int
numargs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
               then ParsecT s st m (Maybe String)
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m (Maybe String)
optArg
               else Maybe String -> ParsecT s st m (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
  let numargs' :: Int
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
  ParsecT s st m ()
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
  String
body <- 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
  let defn :: String
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
"}"
  Macro -> ParsecT s st m Macro
forall (m :: * -> *) a. Monad m => a -> m a
return (Macro -> ParsecT s st m Macro) -> Macro -> ParsecT s st m Macro
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 st (m :: * -> *) s.
  Stream s m Char =>
  ParsecT s st m Text)
 -> Macro)
-> (forall st (m :: * -> *) s.
    Stream s m Char =>
    ParsecT s st m Text)
-> Macro
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> ParsecT s st m String -> ParsecT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (ParsecT s st m String -> ParsecT s st m Text)
-> ParsecT s st m String -> ParsecT s st m Text
forall a b. (a -> b) -> a -> b
$ 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
'\\'
    String -> ParsecT s st m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
name'
    Bool -> ParsecT s st m () -> ParsecT s st m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isLetter String
name') (ParsecT s st m () -> ParsecT s st m ())
-> ParsecT s st m () -> ParsecT s st m ()
forall a b. (a -> b) -> a -> b
$
      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
letter
    ParsecT s st m ()
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  -> Maybe String -> ParsecT s st m (Maybe String)
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 (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
    [String]
args <- Int -> ParsecT s st m String -> 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
numargs' (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 String -> ParsecT s st m String
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
<|> ParsecT s st m String
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
ctrlseq 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))
    let args' :: [String]
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
    String -> ParsecT s st m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT s st m String)
-> String -> ParsecT s st m String
forall a b. (a -> b) -> a -> b
$ [String] -> ShowS
apply [String]
args' ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
body String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"

newenvironment :: (Monad m, Stream s m Char)
               => ParsecT s st m Macro
newenvironment :: 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
  String
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
  Int
numargs <- ParsecT s st m Int
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m Int
numArgs
  ParsecT s st m ()
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
  Maybe String
optarg <- if Int
numargs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
               then ParsecT s st m (Maybe String)
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m (Maybe String)
optArg ParsecT s st m (Maybe String)
-> ParsecT s st m () -> ParsecT s st m (Maybe String)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s st m ()
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
               else Maybe String -> ParsecT s st m (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
  let numargs' :: Int
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
  String
opener <- 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
  ParsecT s st m ()
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m ()
pSkipSpaceComments
  String
closer <- 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
  let defn :: String
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
"}"
  Macro -> ParsecT s st m Macro
forall (m :: * -> *) a. Monad m => a -> m a
return (Macro -> ParsecT s st m Macro) -> Macro -> ParsecT s st m Macro
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 st (m :: * -> *) s.
  Stream s m Char =>
  ParsecT s st m Text)
 -> Macro)
-> (forall st (m :: * -> *) s.
    Stream s m Char =>
    ParsecT s st m Text)
-> Macro
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> ParsecT s st m String -> ParsecT s st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (ParsecT s st m String -> ParsecT s st m Text)
-> ParsecT s st m String -> ParsecT s st m Text
forall a b. (a -> b) -> a -> b
$ 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
    String -> ParsecT s st m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\begin"
    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
'{'
    String -> ParsecT s st m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
name
    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
'}'
    Maybe String
opt <- case Maybe String
optarg of
                Maybe String
Nothing  -> Maybe String -> ParsecT s st m (Maybe String)
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 (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
    [String]
args <- Int -> ParsecT s st m String -> 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
numargs' (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 String -> ParsecT s st m String
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
<|> ParsecT s st m String
forall (m :: * -> *) s st.
(Monad m, Stream s m Char) =>
ParsecT s st m String
ctrlseq 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))
    let args' :: [String]
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
    let ender :: ParsecT s u m Char
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
'}'
    String
body <- ParsecT s st m Char -> 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 Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT s st m Char
forall u. ParsecT s u m Char
ender
    String -> ParsecT s st m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT s st m String)
-> String -> ParsecT s st m String
forall a b. (a -> b) -> a -> b
$ [String] -> ShowS
apply [String]
args'
           ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
opener String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
body String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
closer

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

numArgs :: (Monad m, Stream s m Char)
        => ParsecT s st m Int
numArgs :: 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
  Char
n <- ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
  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
']'
  Int -> ParsecT s st m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ParsecT s st m Int) -> Int -> ParsecT s st m Int
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Read a => String -> a
read [Char
n]

optArg :: (Monad m, Stream s m Char)
       => ParsecT s st m (Maybe String)
optArg :: 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 :: 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 (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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
x -> String -> ParsecT s st m String
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 :: 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
  [String]
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 (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 (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
']')
  String -> ParsecT s st m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT s st m String)
-> String -> ParsecT s st m String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
res

inbraces :: (Monad m, Stream s m Char)
         => ParsecT s st m String
inbraces :: 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
'{'
  [String]
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 (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
<|> 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 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 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 (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
'}')
  String -> ParsecT s st m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT s st m String)
-> String -> ParsecT s st m String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
res

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