{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
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)
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
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)
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
pSkipSpaceComments :: (Monad m, Stream s m Char)
=> ParsecT s st m ()
= 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)
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 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)
([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
_ = Maybe a
forall a. Maybe a
Nothing
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 :: 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
'\\'
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
'\\'
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 $ try $ do
string "\\begin"
pSkipSpaceComments
char '{'
string name
pSkipSpaceComments
char '}'
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
let 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
'}'
body <- manyTill anyChar ender
return $ apply args'
$ opener ++ body ++ closer
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 ()
= 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 ()
= 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
<|> 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 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 ++ "}")