{-# LANGUAGE ViewPatterns, ScopedTypeVariables, OverloadedStrings #-}
module Text.TeXMath.Writers.MathML (writeMathML)
where
import Text.XML.Light
import Text.TeXMath.Types
import Text.TeXMath.Unicode.ToUnicode
import Data.Generics (everywhere, mkT)
import Text.TeXMath.Shared (getMMLType, handleDownup)
import Text.TeXMath.Readers.MathML.MMLDict (getMathMLOperator)
import Control.Applicative ((<$>))
import Data.Semigroup ((<>))
import qualified Data.Text as T
import Text.Printf
writeMathML :: DisplayType -> [Exp] -> Element
writeMathML :: DisplayType -> [Exp] -> Element
writeMathML DisplayType
dt [Exp]
exprs =
Attr -> Element -> Element
add_attr Attr
dtattr (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Element -> Element
math (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ TextType -> Exp -> Element
showExp TextType
TextNormal (Exp -> Element) -> Exp -> Element
forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
EGrouped
([Exp] -> Exp) -> [Exp] -> Exp
forall a b. (a -> b) -> a -> b
$ (forall a. Data a => a -> a) -> [Exp] -> [Exp]
(forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere ((Exp -> Exp) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT ((Exp -> Exp) -> a -> a) -> (Exp -> Exp) -> a -> a
forall a b. (a -> b) -> a -> b
$ DisplayType -> Exp -> Exp
handleDownup DisplayType
dt) [Exp]
exprs
where dtattr :: Attr
dtattr = QName -> String -> Attr
Attr (String -> QName
unqual String
"display") String
dt'
dt' :: String
dt' = case DisplayType
dt of
DisplayType
DisplayBlock -> String
"block"
DisplayType
DisplayInline -> String
"inline"
math :: Element -> Element
math :: Element -> Element
math = Attr -> Element -> Element
add_attr (QName -> String -> Attr
Attr (String -> QName
unqual String
"xmlns") String
"http://www.w3.org/1998/Math/MathML") (Element -> Element) -> (Element -> Element) -> Element -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Element -> Element
forall t. Node t => String -> t -> Element
unode String
"math"
mrow :: [Element] -> Element
mrow :: [Element] -> Element
mrow = String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"mrow"
showFraction :: TextType -> FractionType -> Exp -> Exp -> Element
showFraction :: TextType -> FractionType -> Exp -> Exp -> Element
showFraction TextType
tt FractionType
ft Exp
x Exp
y =
case FractionType
ft of
FractionType
NormalFrac -> String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"mfrac" [Element
x', Element
y']
FractionType
InlineFrac -> String -> Text -> Element -> Element
withAttribute String
"displaystyle" Text
"false" (Element -> Element)
-> ([Element] -> Element) -> [Element] -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> Element -> Element
forall t. Node t => String -> t -> Element
unode String
"mstyle" (Element -> Element)
-> ([Element] -> Element) -> [Element] -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"mfrac" ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ [Element
x', Element
y']
FractionType
DisplayFrac -> String -> Text -> Element -> Element
withAttribute String
"displaystyle" Text
"true" (Element -> Element)
-> ([Element] -> Element) -> [Element] -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> Element -> Element
forall t. Node t => String -> t -> Element
unode String
"mstyle" (Element -> Element)
-> ([Element] -> Element) -> [Element] -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"mfrac" ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ [Element
x', Element
y']
FractionType
NoLineFrac -> String -> Text -> Element -> Element
withAttribute String
"linethickness" Text
"0" (Element -> Element)
-> ([Element] -> Element) -> [Element] -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"mfrac" ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ [Element
x', Element
y']
where x' :: Element
x' = TextType -> Exp -> Element
showExp TextType
tt Exp
x
y' :: Element
y' = TextType -> Exp -> Element
showExp TextType
tt Exp
y
spaceWidth :: Rational -> Element
spaceWidth :: Rational -> Element
spaceWidth Rational
w =
String -> Text -> Element -> Element
withAttribute String
"width" (Text -> Text
dropTrailing0s
(String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.3f" (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
w :: Double)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"em") (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ String -> () -> Element
forall t. Node t => String -> t -> Element
unode String
"mspace" ()
makeStretchy :: FormType -> Element -> Element
makeStretchy :: FormType -> Element -> Element
makeStretchy (FormType -> Text
fromForm -> Text
t) = String -> Text -> Element -> Element
withAttribute String
"stretchy" Text
"true"
(Element -> Element) -> (Element -> Element) -> Element -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text -> Element -> Element
withAttribute String
"form" Text
t
fromForm :: FormType -> T.Text
fromForm :: FormType -> Text
fromForm FormType
FInfix = Text
"infix"
fromForm FormType
FPostfix = Text
"postfix"
fromForm FormType
FPrefix = Text
"prefix"
makeScaled :: Rational -> Element -> Element
makeScaled :: Rational -> Element -> Element
makeScaled Rational
x = String -> Text -> Element -> Element
withAttribute String
"minsize" Text
s (Element -> Element) -> (Element -> Element) -> Element -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text -> Element -> Element
withAttribute String
"maxsize" Text
s
where s :: Text
s = Text -> Text
dropTrailing0s (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.3f" (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
x :: Double)
dropTrailing0s :: T.Text -> T.Text
dropTrailing0s :: Text -> Text
dropTrailing0s Text
t = case Text -> Maybe (Text, Char)
T.unsnoc Text
t of
Just (Text
ts, Char
'0') -> Text -> Text
addZero (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0') Text
ts
Maybe (Text, Char)
_ -> Text
t
where
addZero :: Text -> Text
addZero Text
x = case Text -> Maybe (Text, Char)
T.unsnoc Text
x of
Just (Text
_, Char
'.') -> Text -> Char -> Text
T.snoc Text
x Char
'0'
Maybe (Text, Char)
_ -> Text
x
makeStyled :: TextType -> [Element] -> Element
makeStyled :: TextType -> [Element] -> Element
makeStyled TextType
a [Element]
es = String -> Text -> Element -> Element
withAttribute String
"mathvariant" Text
attr
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"mstyle" [Element]
es
where attr :: Text
attr = TextType -> Text
getMMLType TextType
a
makeText :: TextType -> T.Text -> Element
makeText :: TextType -> Text -> Element
makeText TextType
a Text
s = case (Bool
leadingSp, Bool
trailingSp) of
(Bool
False, Bool
False) -> Element
s'
(Bool
True, Bool
False) -> [Element] -> Element
mrow [Element
sp, Element
s']
(Bool
False, Bool
True) -> [Element] -> Element
mrow [Element
s', Element
sp]
(Bool
True, Bool
True) -> [Element] -> Element
mrow [Element
sp, Element
s', Element
sp]
where sp :: Element
sp = Rational -> Element
spaceWidth (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
3)
s' :: Element
s' = String -> Text -> Element -> Element
withAttribute String
"mathvariant" Text
attr (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ String -> Text -> Element
tunode String
"mtext" (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$ TextType -> Text -> Text
toUnicode TextType
a Text
s
trailingSp :: Bool
trailingSp = case Text -> Maybe (Text, Char)
T.unsnoc Text
s of
Just (Text
_, Char
c) -> (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) Text
" \t"
Maybe (Text, Char)
_ -> Bool
False
leadingSp :: Bool
leadingSp = case Text -> Maybe (Char, Text)
T.uncons Text
s of
Just (Char
c, Text
_) -> (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) Text
" \t"
Maybe (Char, Text)
_ -> Bool
False
attr :: Text
attr = TextType -> Text
getMMLType TextType
a
makeArray :: TextType -> [Alignment] -> [ArrayLine] -> Element
makeArray :: TextType -> [Alignment] -> [ArrayLine] -> Element
makeArray TextType
tt [Alignment]
as [ArrayLine]
ls = String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"mtable" ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
(ArrayLine -> Element) -> [ArrayLine] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"mtr" ([Element] -> Element)
-> (ArrayLine -> [Element]) -> ArrayLine -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Alignment -> [Exp] -> Element)
-> [Alignment] -> ArrayLine -> [Element]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Alignment
a -> Alignment -> Element -> Element
setAlignment Alignment
a (Element -> Element) -> ([Exp] -> Element) -> [Exp] -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"mtd"([Element] -> Element) -> ([Exp] -> [Element]) -> [Exp] -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp -> Element) -> [Exp] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (TextType -> Exp -> Element
showExp TextType
tt)) [Alignment]
as') [ArrayLine]
ls
where setAlignment :: Alignment -> Element -> Element
setAlignment Alignment
AlignLeft = String -> Text -> Element -> Element
withAttribute String
"columnalign" Text
"left"
setAlignment Alignment
AlignRight = String -> Text -> Element -> Element
withAttribute String
"columnalign" Text
"right"
setAlignment Alignment
AlignCenter = String -> Text -> Element -> Element
withAttribute String
"columnalign" Text
"center"
as' :: [Alignment]
as' = [Alignment]
as [Alignment] -> [Alignment] -> [Alignment]
forall a. [a] -> [a] -> [a]
++ [Alignment] -> [Alignment]
forall a. [a] -> [a]
cycle [Alignment
AlignCenter]
withAttribute :: String -> T.Text -> Element -> Element
withAttribute :: String -> Text -> Element -> Element
withAttribute String
a = Attr -> Element -> Element
add_attr (Attr -> Element -> Element)
-> (Text -> Attr) -> Text -> Element -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> String -> Attr
Attr (String -> QName
unqual String
a) (String -> Attr) -> (Text -> String) -> Text -> Attr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
accent :: T.Text -> Element
accent :: Text -> Element
accent = Attr -> Element -> Element
add_attr (QName -> String -> Attr
Attr (String -> QName
unqual String
"accent") String
"true") (Element -> Element) -> (Text -> Element) -> Text -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> Text -> Element
tunode String
"mo"
makeFence :: FormType -> Element -> Element
makeFence :: FormType -> Element -> Element
makeFence (FormType -> Text
fromForm -> Text
t) = String -> Text -> Element -> Element
withAttribute String
"stretchy" Text
"false" (Element -> Element) -> (Element -> Element) -> Element -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text -> Element -> Element
withAttribute String
"form" Text
t
showExp' :: TextType -> Exp -> Element
showExp' :: TextType -> Exp -> Element
showExp' TextType
tt Exp
e =
case Exp
e of
ESymbol TeXSymbolType
Accent Text
x -> Text -> Element
accent Text
x
ESymbol TeXSymbolType
_ Text
x ->
let isaccent :: Text
isaccent = case (Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Text
"accent") ([Text] -> Bool) -> (Operator -> [Text]) -> Operator -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Operator -> [Text]
properties (Operator -> Bool) -> Maybe Operator -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Text -> FormType -> Maybe Operator
getMathMLOperator Text
x FormType
FPostfix of
Just Bool
True -> Text
"true"
Maybe Bool
_ -> Text
"false"
in String -> Text -> Element -> Element
withAttribute String
"accent" Text
isaccent (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ String -> Text -> Element
tunode String
"mo" Text
x
Exp
_ -> TextType -> Exp -> Element
showExp TextType
tt Exp
e
showExp :: TextType -> Exp -> Element
showExp :: TextType -> Exp -> Element
showExp TextType
tt Exp
e =
case Exp
e of
ENumber Text
x -> String -> Text -> Element
tunode String
"mn" Text
x
EGrouped [Exp
x] -> TextType -> Exp -> Element
showExp TextType
tt Exp
x
EGrouped [Exp]
xs -> [Element] -> Element
mrow ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ (Exp -> Element) -> [Exp] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (TextType -> Exp -> Element
showExp TextType
tt) [Exp]
xs
EDelimited Text
start Text
end [InEDelimited]
xs -> [Element] -> Element
mrow ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$
[ FormType -> Element -> Element
makeStretchy FormType
FPrefix (String -> Text -> Element
tunode String
"mo" Text
start) | Bool -> Bool
not (Text -> Bool
T.null Text
start) ] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(InEDelimited -> Element) -> [InEDelimited] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Element) -> (Exp -> Element) -> InEDelimited -> Element
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FormType -> Element -> Element
makeStretchy FormType
FInfix (Element -> Element) -> (Text -> Element) -> Text -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text -> Element
tunode String
"mo") (TextType -> Exp -> Element
showExp TextType
tt)) [InEDelimited]
xs [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
[ FormType -> Element -> Element
makeStretchy FormType
FPostfix (String -> Text -> Element
tunode String
"mo" Text
end) | Bool -> Bool
not (Text -> Bool
T.null Text
end) ]
EIdentifier Text
x -> String -> Text -> Element
tunode String
"mi" (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$ TextType -> Text -> Text
toUnicode TextType
tt Text
x
EMathOperator Text
x -> String -> Text -> Element
tunode String
"mo" Text
x
ESymbol TeXSymbolType
Open Text
x -> FormType -> Element -> Element
makeFence FormType
FPrefix (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ String -> Text -> Element
tunode String
"mo" Text
x
ESymbol TeXSymbolType
Close Text
x -> FormType -> Element -> Element
makeFence FormType
FPostfix (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ String -> Text -> Element
tunode String
"mo" Text
x
ESymbol TeXSymbolType
Ord Text
x -> String -> Text -> Element
tunode String
"mi" Text
x
ESymbol TeXSymbolType
_ Text
x -> String -> Text -> Element
tunode String
"mo" Text
x
ESpace Rational
x -> Rational -> Element
spaceWidth Rational
x
EFraction FractionType
ft Exp
x Exp
y -> TextType -> FractionType -> Exp -> Exp -> Element
showFraction TextType
tt FractionType
ft Exp
x Exp
y
ESub Exp
x Exp
y -> String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"msub" ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ (Exp -> Element) -> [Exp] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (TextType -> Exp -> Element
showExp TextType
tt) [Exp
x, Exp
y]
ESuper Exp
x Exp
y -> String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"msup" ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ (Exp -> Element) -> [Exp] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (TextType -> Exp -> Element
showExp TextType
tt) [Exp
x, Exp
y]
ESubsup Exp
x Exp
y Exp
z -> String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"msubsup" ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ (Exp -> Element) -> [Exp] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (TextType -> Exp -> Element
showExp TextType
tt) [Exp
x, Exp
y, Exp
z]
EUnder Bool
_ Exp
x Exp
y -> String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"munder" [TextType -> Exp -> Element
showExp TextType
tt Exp
x, TextType -> Exp -> Element
showExp' TextType
tt Exp
y]
EOver Bool
_ Exp
x Exp
y -> String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"mover" [TextType -> Exp -> Element
showExp TextType
tt Exp
x, TextType -> Exp -> Element
showExp' TextType
tt Exp
y]
EUnderover Bool
_ Exp
x Exp
y Exp
z -> String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"munderover"
[TextType -> Exp -> Element
showExp TextType
tt Exp
x, TextType -> Exp -> Element
showExp' TextType
tt Exp
y, TextType -> Exp -> Element
showExp' TextType
tt Exp
z]
EPhantom Exp
x -> String -> Element -> Element
forall t. Node t => String -> t -> Element
unode String
"mphantom" (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ TextType -> Exp -> Element
showExp TextType
tt Exp
x
EBoxed Exp
x -> String -> Text -> Element -> Element
withAttribute String
"notation" Text
"box" (Element -> Element) -> (Element -> Element) -> Element -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> Element -> Element
forall t. Node t => String -> t -> Element
unode String
"menclose" (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ TextType -> Exp -> Element
showExp TextType
tt Exp
x
ESqrt Exp
x -> String -> Element -> Element
forall t. Node t => String -> t -> Element
unode String
"msqrt" (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ TextType -> Exp -> Element
showExp TextType
tt Exp
x
ERoot Exp
i Exp
x -> String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode String
"mroot" [TextType -> Exp -> Element
showExp TextType
tt Exp
x, TextType -> Exp -> Element
showExp TextType
tt Exp
i]
EScaled Rational
s Exp
x -> Rational -> Element -> Element
makeScaled Rational
s (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ TextType -> Exp -> Element
showExp TextType
tt Exp
x
EArray [Alignment]
as [ArrayLine]
ls -> TextType -> [Alignment] -> [ArrayLine] -> Element
makeArray TextType
tt [Alignment]
as [ArrayLine]
ls
EText TextType
a Text
s -> TextType -> Text -> Element
makeText TextType
a Text
s
EStyled TextType
a [Exp]
es -> TextType -> [Element] -> Element
makeStyled TextType
a ([Element] -> Element) -> [Element] -> Element
forall a b. (a -> b) -> a -> b
$ (Exp -> Element) -> [Exp] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map (TextType -> Exp -> Element
showExp TextType
a) [Exp]
es
tunode :: String -> T.Text -> Element
tunode :: String -> Text -> Element
tunode String
s = String -> String -> Element
forall t. Node t => String -> t -> Element
unode String
s (String -> Element) -> (Text -> String) -> Text -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack