module MarXup.Math where
import Control.Applicative
import MarXup.Latex
import MarXup.Latex.Math
import MarXup.Tex
import MarXup
import Data.Monoid
import Data.Ratio
import Data.String
import Control.Monad (unless)
instance Element Math where
type Target Math = TeX
element = inline
instance IsString Math where
fromString = Con . fromString
inline x = " " <> (cmd "ensuremath" . mRender 0 $ x) <> " "
display x = tex "$$" <> mRender 0 x <> tex "$$"
text :: TeX -> Math
text = Con . cmd "text"
data Math = BinOp Int (TeX -> TeX -> TeX) Int Int Math Math
| UnOp Int (TeX -> TeX) Int Math
| Con TeX
| Math (Int -> TeX)
| Invisible (TeX -> TeX) Math
parp p p' = if p' < p then bigParen else id
mRender :: Int -> Math -> TeX
mRender _ (Con x) = x
mRender p (Math x) = x p
mRender p (BinOp p' f pl pr l r) = parp p p' $ f (mRender pl l) (mRender pr r)
mRender p (UnOp p' f px x) = parp p p' $ f (mRender px x)
mRender p (Invisible f x) = f $ mRender p x
ternaryOp :: Int -> (TeX -> TeX -> TeX -> TeX) -> Int -> Int -> Int -> Math -> Math -> Math -> Math
ternaryOp p' f px py pz x y z = Math $ \p -> parp p p' $ f (mRender px x)(mRender py y)(mRender pz z)
binop :: Int -> TeX -> Math -> Math -> Math
binop prec op = BinOp prec (\x y -> x <> op <> y) prec prec
preop prec op = UnOp prec (\x -> x <> op) prec
outop left right = UnOp 100 (parenthesize left right) 0
fct x = UnOp 6 (x <>) 7
infixr 1 =:
(=:) = binop 0 "="
instance Num Math where
(+) = binop 1 "+"
() = binop 1 "-"
(*) = binop 2 ""
abs = outop (cmd0 "mid") (cmd0 "mid")
signum = preop 10 $ cmd0 "delta"
fromInteger x = Con $ textual $ show x
negate = preop 1 "-"
instance Fractional Math where
(/) = BinOp 10 (\a b -> cmdn_ "frac" [a,b]) 0 0
fromRational r = fromInteger (numerator r) / fromInteger (denominator r)
instance Floating Math where
pi = Con $ cmd0 "pi"
exp = UnOp 20 (\x -> tex "e^" <> braces x) 0
sqrt = UnOp 10 (cmd "sqrt") 0
log = fct (cmd "mathnormal" "log")
sin = fct (cmd "mathnormal" "sin")
cos = fct (cmd "mathnormal" "cos")
tan = fct (cmd "mathnormal" "tan")
asin = fct (cmd "mathnormal" "asin")
acos = fct (cmd "mathnormal" "acos")
atan = fct (cmd "mathnormal" "atan")
sinh = fct (cmd "mathnormal" "sinh")
cosh = fct (cmd "mathnormal" "cosh")
asinh = fct (cmd "mathnormal" "asinh")
acosh = fct (cmd "mathnormal" "acosh")
atanh = fct (cmd "mathnormal" "atanh")
(**) = (^^^)
ceiling, floor :: Math -> Math
ceiling = outop "⌈" "⌉"
floor = outop "⌊" "⌋"
(^^^) = BinOp 5 (\x y -> braces x <> superscript y) 5 6
($$$) = BinOp 5 (\x y -> braces x <> subscript y) 5 6