{-# LANGUAGE FlexibleInstances #-}

{- |
Module      : Language.Egison.PrettyMath.AST
Licence     : MIT
-}

module Language.Egison.PrettyMath.AST
  ( MathExpr(..)
  , MathIndex(..)
  , ToMathExpr(..)
  , isSub
  , parseExpr
  ) where

import           Data.Foldable                 (toList)
import           Text.ParserCombinators.Parsec hiding (spaces)

import qualified Language.Egison.Data          as E
import qualified Language.Egison.IExpr         as E
import qualified Language.Egison.Math.Expr     as E

data MathExpr
  = Atom String [MathIndex]
  | NegativeAtom String
  | Plus [MathExpr]
  | Multiply [MathExpr]
  | Div MathExpr MathExpr
  | Power MathExpr MathExpr
  | Func MathExpr [MathExpr]
  | Tensor [MathExpr] [MathIndex]
  | Tuple [MathExpr]
  | Collection [MathExpr]
  | Quote MathExpr
  | Partial MathExpr [MathExpr]
  deriving (MathExpr -> MathExpr -> Bool
(MathExpr -> MathExpr -> Bool)
-> (MathExpr -> MathExpr -> Bool) -> Eq MathExpr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MathExpr -> MathExpr -> Bool
$c/= :: MathExpr -> MathExpr -> Bool
== :: MathExpr -> MathExpr -> Bool
$c== :: MathExpr -> MathExpr -> Bool
Eq, Int -> MathExpr -> ShowS
[MathExpr] -> ShowS
MathExpr -> String
(Int -> MathExpr -> ShowS)
-> (MathExpr -> String) -> ([MathExpr] -> ShowS) -> Show MathExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MathExpr] -> ShowS
$cshowList :: [MathExpr] -> ShowS
show :: MathExpr -> String
$cshow :: MathExpr -> String
showsPrec :: Int -> MathExpr -> ShowS
$cshowsPrec :: Int -> MathExpr -> ShowS
Show)

data MathIndex
  = Super MathExpr
  | Sub MathExpr
  deriving (MathIndex -> MathIndex -> Bool
(MathIndex -> MathIndex -> Bool)
-> (MathIndex -> MathIndex -> Bool) -> Eq MathIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MathIndex -> MathIndex -> Bool
$c/= :: MathIndex -> MathIndex -> Bool
== :: MathIndex -> MathIndex -> Bool
$c== :: MathIndex -> MathIndex -> Bool
Eq, Int -> MathIndex -> ShowS
[MathIndex] -> ShowS
MathIndex -> String
(Int -> MathIndex -> ShowS)
-> (MathIndex -> String)
-> ([MathIndex] -> ShowS)
-> Show MathIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MathIndex] -> ShowS
$cshowList :: [MathIndex] -> ShowS
show :: MathIndex -> String
$cshow :: MathIndex -> String
showsPrec :: Int -> MathIndex -> ShowS
$cshowsPrec :: Int -> MathIndex -> ShowS
Show)

isSub :: MathIndex -> Bool
isSub :: MathIndex -> Bool
isSub (Sub MathExpr
_) = Bool
True
isSub MathIndex
_       = Bool
False


class ToMathExpr a where
  toMathExpr :: a -> MathExpr

instance ToMathExpr E.EgisonValue where
  toMathExpr :: EgisonValue -> MathExpr
toMathExpr (E.ScalarData ScalarData
s)  = ScalarData -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr ScalarData
s
  toMathExpr (E.Tuple [EgisonValue]
es)      = [MathExpr] -> MathExpr
Tuple ((EgisonValue -> MathExpr) -> [EgisonValue] -> [MathExpr]
forall a b. (a -> b) -> [a] -> [b]
map EgisonValue -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr [EgisonValue]
es)
  toMathExpr (E.Collection Seq EgisonValue
es) = [MathExpr] -> MathExpr
Collection ((EgisonValue -> MathExpr) -> [EgisonValue] -> [MathExpr]
forall a b. (a -> b) -> [a] -> [b]
map EgisonValue -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr (Seq EgisonValue -> [EgisonValue]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq EgisonValue
es))
  toMathExpr (E.TensorData Tensor EgisonValue
t)  = Tensor EgisonValue -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr Tensor EgisonValue
t
  toMathExpr EgisonValue
e                 = String -> [MathIndex] -> MathExpr
Atom (EgisonValue -> String
forall a. Show a => a -> String
show EgisonValue
e) []

instance ToMathExpr a => ToMathExpr (E.Tensor a) where
  toMathExpr :: Tensor a -> MathExpr
toMathExpr (E.Scalar a
_)       = MathExpr
forall a. HasCallStack => a
undefined
  toMathExpr (E.Tensor [Integer
_] Vector a
xs [Index EgisonValue]
js) = [MathExpr] -> [MathIndex] -> MathExpr
Tensor ((a -> MathExpr) -> [a] -> [MathExpr]
forall a b. (a -> b) -> [a] -> [b]
map a -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr (Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Vector a
xs)) ((Index EgisonValue -> MathIndex)
-> [Index EgisonValue] -> [MathIndex]
forall a b. (a -> b) -> [a] -> [b]
map Index EgisonValue -> MathIndex
forall a. ToMathExpr a => Index a -> MathIndex
toMathIndex [Index EgisonValue]
js)
  toMathExpr (E.Tensor [Integer
_, Integer
n] Vector a
xs [Index EgisonValue]
js) = [MathExpr] -> [MathIndex] -> MathExpr
Tensor (Int -> [MathExpr] -> [MathExpr]
f (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n) ((a -> MathExpr) -> [a] -> [MathExpr]
forall a b. (a -> b) -> [a] -> [b]
map a -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr (Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Vector a
xs))) ((Index EgisonValue -> MathIndex)
-> [Index EgisonValue] -> [MathIndex]
forall a b. (a -> b) -> [a] -> [b]
map Index EgisonValue -> MathIndex
forall a. ToMathExpr a => Index a -> MathIndex
toMathIndex [Index EgisonValue]
js)
    where
      f :: Int -> [MathExpr] -> [MathExpr]
f Int
_ [] = []
      f Int
n [MathExpr]
xs = [MathExpr] -> [MathIndex] -> MathExpr
Tensor (Int -> [MathExpr] -> [MathExpr]
forall a. Int -> [a] -> [a]
take Int
n [MathExpr]
xs) [] MathExpr -> [MathExpr] -> [MathExpr]
forall a. a -> [a] -> [a]
: Int -> [MathExpr] -> [MathExpr]
f Int
n (Int -> [MathExpr] -> [MathExpr]
forall a. Int -> [a] -> [a]
drop Int
n [MathExpr]
xs)
  toMathExpr (E.Tensor [Integer]
_ Vector a
_ [Index EgisonValue]
_) = MathExpr
forall a. HasCallStack => a
undefined

instance ToMathExpr E.ScalarData where
  toMathExpr :: ScalarData -> MathExpr
toMathExpr (E.Div PolyExpr
p (E.Plus [E.Term Integer
1 []])) = PolyExpr -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr PolyExpr
p
  toMathExpr (E.Div PolyExpr
p1 PolyExpr
p2)                    = MathExpr -> MathExpr -> MathExpr
Div (PolyExpr -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr PolyExpr
p1) (PolyExpr -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr PolyExpr
p2)

instance ToMathExpr E.PolyExpr where
  toMathExpr :: PolyExpr -> MathExpr
toMathExpr (E.Plus [])  = String -> [MathIndex] -> MathExpr
Atom String
"0" []
  toMathExpr (E.Plus [TermExpr
x]) = TermExpr -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr TermExpr
x
  toMathExpr (E.Plus [TermExpr]
xs)  = [MathExpr] -> MathExpr
Plus ((TermExpr -> MathExpr) -> [TermExpr] -> [MathExpr]
forall a b. (a -> b) -> [a] -> [b]
map TermExpr -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr [TermExpr]
xs)

instance ToMathExpr E.TermExpr where
  toMathExpr :: TermExpr -> MathExpr
toMathExpr (E.Term Integer
n [])  = Integer -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr Integer
n
  toMathExpr (E.Term Integer
1 [(SymbolExpr, Integer)
x]) = (SymbolExpr, Integer) -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr (SymbolExpr, Integer)
x
  toMathExpr (E.Term Integer
1 [(SymbolExpr, Integer)]
xs)  = [MathExpr] -> MathExpr
Multiply (((SymbolExpr, Integer) -> MathExpr)
-> [(SymbolExpr, Integer)] -> [MathExpr]
forall a b. (a -> b) -> [a] -> [b]
map (SymbolExpr, Integer) -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr [(SymbolExpr, Integer)]
xs)
  toMathExpr (E.Term Integer
n [(SymbolExpr, Integer)]
xs)  = [MathExpr] -> MathExpr
Multiply (Integer -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr Integer
n MathExpr -> [MathExpr] -> [MathExpr]
forall a. a -> [a] -> [a]
: ((SymbolExpr, Integer) -> MathExpr)
-> [(SymbolExpr, Integer)] -> [MathExpr]
forall a b. (a -> b) -> [a] -> [b]
map (SymbolExpr, Integer) -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr [(SymbolExpr, Integer)]
xs)

instance ToMathExpr Integer where
  toMathExpr :: Integer -> MathExpr
toMathExpr Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = String -> MathExpr
NegativeAtom (Integer -> String
forall a. Show a => a -> String
show (-Integer
n))
  toMathExpr Integer
n         = String -> [MathIndex] -> MathExpr
Atom (Integer -> String
forall a. Show a => a -> String
show Integer
n) []

instance {-# OVERLAPPING #-} ToMathExpr (E.SymbolExpr, Integer) where
  toMathExpr :: (SymbolExpr, Integer) -> MathExpr
toMathExpr (SymbolExpr
x, Integer
1) = SymbolExpr -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr SymbolExpr
x
  toMathExpr (SymbolExpr
x, Integer
n) = MathExpr -> MathExpr -> MathExpr
Power (SymbolExpr -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr SymbolExpr
x) (Integer -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr Integer
n)

instance ToMathExpr E.SymbolExpr where
  toMathExpr :: SymbolExpr -> MathExpr
toMathExpr (E.Symbol String
_ (Char
':':Char
':':Char
':':String
_) []) = String -> [MathIndex] -> MathExpr
Atom String
"#" []
  toMathExpr (E.Symbol String
_ String
s [Index ScalarData]
js) = [Index ScalarData] -> MathExpr -> MathExpr
forall a. ToMathExpr a => [Index a] -> MathExpr -> MathExpr
toMathExpr' [Index ScalarData]
js (String -> [MathIndex] -> MathExpr
Atom String
s [])
    where
      toMathExpr' :: [Index a] -> MathExpr -> MathExpr
toMathExpr' [] MathExpr
acc = MathExpr
acc
      toMathExpr' (E.User a
x:[Index a]
js) (Partial MathExpr
e [MathExpr]
ps) =
        [Index a] -> MathExpr -> MathExpr
toMathExpr' [Index a]
js (MathExpr -> [MathExpr] -> MathExpr
Partial MathExpr
e ([MathExpr]
ps [MathExpr] -> [MathExpr] -> [MathExpr]
forall a. [a] -> [a] -> [a]
++ [a -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr a
x]))
      toMathExpr' (E.User a
x:[Index a]
js) e :: MathExpr
e@Atom{} =
        [Index a] -> MathExpr -> MathExpr
toMathExpr' [Index a]
js (MathExpr -> [MathExpr] -> MathExpr
Partial MathExpr
e [a -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr a
x])
      toMathExpr' (Index a
j:[Index a]
js) (Atom String
e [MathIndex]
is) =
        [Index a] -> MathExpr -> MathExpr
toMathExpr' [Index a]
js (String -> [MathIndex] -> MathExpr
Atom String
e ([MathIndex]
is [MathIndex] -> [MathIndex] -> [MathIndex]
forall a. [a] -> [a] -> [a]
++ [Index a -> MathIndex
forall a. ToMathExpr a => Index a -> MathIndex
toMathIndex Index a
j]))
      toMathExpr' [Index a]
_ MathExpr
_ = MathExpr
forall a. HasCallStack => a
undefined -- TODO

  toMathExpr (E.Apply ScalarData
fn [ScalarData]
mExprs) =
    case (ScalarData -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr ScalarData
fn, [ScalarData]
mExprs) of
      (Atom String
"^" [], [ScalarData
x, ScalarData
y]) -> MathExpr -> MathExpr -> MathExpr
Power (ScalarData -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr ScalarData
x) (ScalarData -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr ScalarData
y)
      (MathExpr, [ScalarData])
_                     -> MathExpr -> [MathExpr] -> MathExpr
Func (ScalarData -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr ScalarData
fn) ((ScalarData -> MathExpr) -> [ScalarData] -> [MathExpr]
forall a b. (a -> b) -> [a] -> [b]
map ScalarData -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr [ScalarData]
mExprs)
  toMathExpr (E.Quote ScalarData
mExpr) = MathExpr -> MathExpr
Quote (ScalarData -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr ScalarData
mExpr)
  toMathExpr (E.FunctionData (E.SingleTerm Integer
1 [(E.Symbol String
_ String
s [Index ScalarData]
js, Integer
1)]) [ScalarData]
_ [ScalarData]
_) = [Index ScalarData] -> MathExpr -> MathExpr
forall a. ToMathExpr a => [Index a] -> MathExpr -> MathExpr
toMathExpr' [Index ScalarData]
js (String -> [MathIndex] -> MathExpr
Atom String
s [])
    where
      toMathExpr' :: [Index a] -> MathExpr -> MathExpr
toMathExpr' [] MathExpr
acc = MathExpr
acc
      toMathExpr' (E.User a
x:[Index a]
js) (Partial MathExpr
e [MathExpr]
ps) =
        [Index a] -> MathExpr -> MathExpr
toMathExpr' [Index a]
js (MathExpr -> [MathExpr] -> MathExpr
Partial MathExpr
e ([MathExpr]
ps [MathExpr] -> [MathExpr] -> [MathExpr]
forall a. [a] -> [a] -> [a]
++ [a -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr a
x]))
      toMathExpr' (E.User a
x:[Index a]
js) e :: MathExpr
e@Atom{} =
        [Index a] -> MathExpr -> MathExpr
toMathExpr' [Index a]
js (MathExpr -> [MathExpr] -> MathExpr
Partial MathExpr
e [a -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr a
x])
      toMathExpr' (Index a
j:[Index a]
js) (Atom String
e [MathIndex]
is) =
        [Index a] -> MathExpr -> MathExpr
toMathExpr' [Index a]
js (String -> [MathIndex] -> MathExpr
Atom String
e ([MathIndex]
is [MathIndex] -> [MathIndex] -> [MathIndex]
forall a. [a] -> [a] -> [a]
++ [Index a -> MathIndex
forall a. ToMathExpr a => Index a -> MathIndex
toMathIndex Index a
j]))
      toMathExpr' [Index a]
_ MathExpr
_ = MathExpr
forall a. HasCallStack => a
undefined -- TODO

toMathIndex :: ToMathExpr a => E.Index a -> MathIndex
toMathIndex :: Index a -> MathIndex
toMathIndex (E.Sub a
x) = MathExpr -> MathIndex
Sub (a -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr a
x)
toMathIndex (E.Sup a
x) = MathExpr -> MathIndex
Super (a -> MathExpr
forall a. ToMathExpr a => a -> MathExpr
toMathExpr a
x)
toMathIndex Index a
_         = MathIndex
forall a. HasCallStack => a
undefined -- TODO

--
-- Parser
--

spaces :: Parser ()
spaces :: Parser ()
spaces = ParsecT String () Identity Char -> Parser ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
skipMany1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space

spaces0 :: Parser ()
spaces0 :: Parser ()
spaces0 = ParsecT String () Identity Char -> Parser ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space

symbol :: Parser Char
symbol :: ParsecT String () Identity Char
symbol = String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"!$%&*+-/:<=>?@#"

parseAtom :: Parser MathExpr
parseAtom :: Parser MathExpr
parseAtom = String -> [MathIndex] -> MathExpr
Atom (String -> [MathIndex] -> MathExpr)
-> ParsecT String () Identity String
-> ParsecT String () Identity ([MathIndex] -> MathExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) (Char -> ShowS)
-> ParsecT String () Identity Char
-> ParsecT String () Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Char
symbol ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit) ParsecT String () Identity ShowS
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Char
symbol)) ParsecT String () Identity ([MathIndex] -> MathExpr)
-> ParsecT String () Identity [MathIndex] -> Parser MathExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity MathIndex
-> ParsecT String () Identity [MathIndex]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String () Identity MathIndex
parseScript

parseAtom' :: Parser MathExpr
parseAtom' :: Parser MathExpr
parseAtom' = (String -> [MathIndex] -> MathExpr)
-> [MathIndex] -> String -> MathExpr
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [MathIndex] -> MathExpr
Atom [] (String -> MathExpr)
-> ParsecT String () Identity String -> Parser MathExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) (Char -> ShowS)
-> ParsecT String () Identity Char
-> ParsecT String () Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Char
symbol ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit) ParsecT String () Identity ShowS
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Char
symbol))

parsePartial :: Parser MathExpr
parsePartial :: Parser MathExpr
parsePartial = MathExpr -> [MathExpr] -> MathExpr
Partial (MathExpr -> [MathExpr] -> MathExpr)
-> Parser MathExpr
-> ParsecT String () Identity ([MathExpr] -> MathExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MathExpr
parseAtom ParsecT String () Identity ([MathExpr] -> MathExpr)
-> ParsecT String () Identity [MathExpr] -> Parser MathExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MathExpr -> ParsecT String () Identity [MathExpr]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'|' ParsecT String () Identity Char
-> Parser MathExpr -> Parser MathExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser MathExpr
parseAtom)

parseNegativeAtom :: Parser MathExpr
parseNegativeAtom :: Parser MathExpr
parseNegativeAtom = Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' ParsecT String () Identity Char
-> Parser MathExpr -> Parser MathExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> MathExpr
NegativeAtom (String -> MathExpr)
-> ParsecT String () Identity String -> Parser MathExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) (Char -> ShowS)
-> ParsecT String () Identity Char
-> ParsecT String () Identity ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Char
symbol ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit) ParsecT String () Identity ShowS
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Char
symbol))

parseList :: Parser [MathExpr]
parseList :: ParsecT String () Identity [MathExpr]
parseList = Parser MathExpr
-> Parser () -> ParsecT String () Identity [MathExpr]
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 Parser MathExpr
parseExpr Parser ()
spaces

parseScript :: Parser MathIndex
parseScript :: ParsecT String () Identity MathIndex
parseScript = MathExpr -> MathIndex
Sub (MathExpr -> MathIndex)
-> Parser MathExpr -> ParsecT String () Identity MathIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_' ParsecT String () Identity Char
-> Parser MathExpr -> Parser MathExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser MathExpr
parseAtom')
              ParsecT String () Identity MathIndex
-> ParsecT String () Identity MathIndex
-> ParsecT String () Identity MathIndex
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> MathExpr -> MathIndex
Super (MathExpr -> MathIndex)
-> Parser MathExpr -> ParsecT String () Identity MathIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'~' ParsecT String () Identity Char
-> Parser MathExpr -> Parser MathExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser MathExpr
parseAtom')

parsePlus :: Parser MathExpr
parsePlus :: Parser MathExpr
parsePlus = ParsecT String () Identity String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"(+") ParsecT String () Identity String -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
spaces Parser () -> Parser MathExpr -> Parser MathExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [MathExpr] -> MathExpr
Plus ([MathExpr] -> MathExpr)
-> ParsecT String () Identity [MathExpr] -> Parser MathExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity [MathExpr]
parseList Parser MathExpr
-> ParsecT String () Identity Char -> Parser MathExpr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'

parseMultiply :: Parser MathExpr
parseMultiply :: Parser MathExpr
parseMultiply = ParsecT String () Identity String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"(*") ParsecT String () Identity String -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
spaces Parser () -> Parser MathExpr -> Parser MathExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [MathExpr] -> MathExpr
Multiply ([MathExpr] -> MathExpr)
-> ParsecT String () Identity [MathExpr] -> Parser MathExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity [MathExpr]
parseList Parser MathExpr
-> ParsecT String () Identity Char -> Parser MathExpr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'

parseDiv :: Parser MathExpr
parseDiv :: Parser MathExpr
parseDiv = ParsecT String () Identity String
-> ParsecT String () Identity String
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"(/") ParsecT String () Identity String -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
spaces Parser () -> Parser MathExpr -> Parser MathExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MathExpr -> MathExpr -> MathExpr
Div (MathExpr -> MathExpr -> MathExpr)
-> Parser MathExpr
-> ParsecT String () Identity (MathExpr -> MathExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MathExpr
parseExpr ParsecT String () Identity (MathExpr -> MathExpr)
-> Parser MathExpr -> Parser MathExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
spaces Parser () -> Parser MathExpr -> Parser MathExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser MathExpr
parseExpr) Parser MathExpr
-> ParsecT String () Identity Char -> Parser MathExpr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'

parseFunction :: Parser MathExpr
parseFunction :: Parser MathExpr
parseFunction = Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'(' ParsecT String () Identity Char
-> Parser MathExpr -> Parser MathExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MathExpr -> [MathExpr] -> MathExpr
Func (MathExpr -> [MathExpr] -> MathExpr)
-> Parser MathExpr
-> ParsecT String () Identity ([MathExpr] -> MathExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MathExpr
parseAtom ParsecT String () Identity ([MathExpr] -> MathExpr)
-> Parser () -> ParsecT String () Identity ([MathExpr] -> MathExpr)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
spaces ParsecT String () Identity ([MathExpr] -> MathExpr)
-> ParsecT String () Identity [MathExpr] -> Parser MathExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity [MathExpr]
parseList Parser MathExpr
-> ParsecT String () Identity Char -> Parser MathExpr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
')'

parseTensor :: Parser MathExpr
parseTensor :: Parser MathExpr
parseTensor = String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"[|" ParsecT String () Identity String -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
spaces0 Parser () -> Parser MathExpr -> Parser MathExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [MathExpr] -> [MathIndex] -> MathExpr
Tensor ([MathExpr] -> [MathIndex] -> MathExpr)
-> ParsecT String () Identity [MathExpr]
-> ParsecT String () Identity ([MathIndex] -> MathExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity [MathExpr]
parseList ParsecT String () Identity ([MathIndex] -> MathExpr)
-> Parser ()
-> ParsecT String () Identity ([MathIndex] -> MathExpr)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
spaces0 ParsecT String () Identity ([MathIndex] -> MathExpr)
-> ParsecT String () Identity String
-> ParsecT String () Identity ([MathIndex] -> MathExpr)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"|]" ParsecT String () Identity ([MathIndex] -> MathExpr)
-> ParsecT String () Identity [MathIndex] -> Parser MathExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity MathIndex
-> ParsecT String () Identity [MathIndex]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String () Identity MathIndex
parseScript

parseTuple :: Parser MathExpr
parseTuple :: Parser MathExpr
parseTuple = Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[' ParsecT String () Identity Char
-> Parser MathExpr -> Parser MathExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [MathExpr] -> MathExpr
Tuple ([MathExpr] -> MathExpr)
-> ParsecT String () Identity [MathExpr] -> Parser MathExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity [MathExpr]
parseList Parser MathExpr
-> ParsecT String () Identity Char -> Parser MathExpr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']'

parseCollection :: Parser MathExpr
parseCollection :: Parser MathExpr
parseCollection = Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{' ParsecT String () Identity Char
-> Parser MathExpr -> Parser MathExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [MathExpr] -> MathExpr
Collection ([MathExpr] -> MathExpr)
-> ParsecT String () Identity [MathExpr] -> Parser MathExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity [MathExpr]
parseList Parser MathExpr
-> ParsecT String () Identity Char -> Parser MathExpr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}'

parseQuote :: Parser MathExpr
parseQuote :: Parser MathExpr
parseQuote = Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'' ParsecT String () Identity Char
-> Parser MathExpr -> Parser MathExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MathExpr -> MathExpr
Quote (MathExpr -> MathExpr) -> Parser MathExpr -> Parser MathExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MathExpr
parseExpr'

parseExpr' :: Parser MathExpr
parseExpr' :: Parser MathExpr
parseExpr' = Parser MathExpr
parseNegativeAtom
         Parser MathExpr -> Parser MathExpr -> Parser MathExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser MathExpr -> Parser MathExpr
forall tok st a. GenParser tok st a -> GenParser tok st a
try Parser MathExpr
parsePartial
         Parser MathExpr -> Parser MathExpr -> Parser MathExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser MathExpr
parseAtom
         Parser MathExpr -> Parser MathExpr -> Parser MathExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser MathExpr
parseQuote
         Parser MathExpr -> Parser MathExpr -> Parser MathExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser MathExpr
parsePlus
         Parser MathExpr -> Parser MathExpr -> Parser MathExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser MathExpr
parseMultiply
         Parser MathExpr -> Parser MathExpr -> Parser MathExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser MathExpr
parseDiv
         Parser MathExpr -> Parser MathExpr -> Parser MathExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser MathExpr -> Parser MathExpr
forall tok st a. GenParser tok st a -> GenParser tok st a
try Parser MathExpr
parseFunction
         Parser MathExpr -> Parser MathExpr -> Parser MathExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser MathExpr -> Parser MathExpr
forall tok st a. GenParser tok st a -> GenParser tok st a
try Parser MathExpr
parseTensor
         Parser MathExpr -> Parser MathExpr -> Parser MathExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser MathExpr -> Parser MathExpr
forall tok st a. GenParser tok st a -> GenParser tok st a
try Parser MathExpr
parseTuple
         Parser MathExpr -> Parser MathExpr -> Parser MathExpr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser MathExpr -> Parser MathExpr
forall tok st a. GenParser tok st a -> GenParser tok st a
try Parser MathExpr
parseCollection

parseExpr :: Parser MathExpr
parseExpr :: Parser MathExpr
parseExpr = do
  MathExpr
x <- Parser MathExpr
parseExpr'
  MathExpr -> Parser MathExpr -> Parser MathExpr
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option MathExpr
x (Parser MathExpr -> Parser MathExpr)
-> Parser MathExpr -> Parser MathExpr
forall a b. (a -> b) -> a -> b
$ MathExpr -> MathExpr -> MathExpr
Power MathExpr
x (MathExpr -> MathExpr) -> Parser MathExpr -> Parser MathExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MathExpr -> Parser MathExpr
forall tok st a. GenParser tok st a -> GenParser tok st a
try (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'^' ParsecT String () Identity Char
-> Parser MathExpr -> Parser MathExpr
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser MathExpr
parseExpr')