{-# LANGUAGE GeneralizedNewtypeDeriving, ViewPatterns, GADTs, OverloadedStrings #-}
{-
Copyright (C) 2014 Matthew Pickering <matthewtpickering@gmail.com>

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

-}

module Text.TeXMath.Writers.TeX (writeTeX, writeTeXWith, addLaTeXEnvironment) where

import Text.TeXMath.Types
import Text.TeXMath.Unicode.ToTeX (getTeXMath)
import Text.TeXMath.Unicode.ToUnicode (fromUnicode)
import qualified Text.TeXMath.Shared as S
import qualified Data.Text as T
import Data.Generics (everywhere, mkT)
import Control.Monad (when, unless, foldM_)
import Control.Monad.Reader (MonadReader, runReader, Reader, asks, local)
import Control.Monad.Writer( MonadWriter, WriterT,
                             execWriterT, tell, censor)
import Text.TeXMath.TeX
import Data.Either (isRight)

-- import Debug.Trace
-- tr' x = trace (show x) x

-- | Transforms an expression tree to equivalent LaTeX with the default
-- packages (amsmath and amssymb)
writeTeX :: [Exp] -> T.Text
writeTeX :: [Exp] -> Text
writeTeX = Env -> [Exp] -> Text
writeTeXWith Env
defaultEnv

-- | Adds the correct LaTeX environment around a TeXMath fragment
addLaTeXEnvironment :: DisplayType -> T.Text -> T.Text
addLaTeXEnvironment :: DisplayType -> Text -> Text
addLaTeXEnvironment DisplayType
dt Text
math =
    case DisplayType
dt of
      DisplayType
DisplayInline -> Text
"\\(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
math Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\)"
      DisplayType
DisplayBlock  -> Text
"\\[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
math Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\\]"

-- |  Transforms an expression tree to equivalent LaTeX with the specified
-- packages
writeTeXWith :: Env -> [Exp] -> T.Text
writeTeXWith :: Env -> [Exp] -> Text
writeTeXWith Env
env [Exp]
es = Int -> Text -> Text
T.drop Int
1 (Text -> Text) -> ([TeX] -> Text) -> [TeX] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text
Text -> Text
T.init (Text -> Text) -> ([TeX] -> Text) -> [TeX] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TeX -> Text -> Text) -> Text -> TeX -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip TeX -> Text -> Text
renderTeX Text
"" (TeX -> Text) -> ([TeX] -> TeX) -> [TeX] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TeX] -> TeX
Grouped ([TeX] -> Text) -> [TeX] -> Text
forall a b. (a -> b) -> a -> b
$
                            Env -> Math () -> [TeX]
runExpr Env
env (Math () -> [TeX]) -> Math () -> [TeX]
forall a b. (a -> b) -> a -> b
$
                              (Exp -> Math ()) -> [Exp] -> Math ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Exp -> Math ()
writeExp ([Exp] -> [Exp]
removeOuterGroup [Exp]
es)

runExpr :: Env -> Math () -> [TeX]
runExpr :: Env -> Math () -> [TeX]
runExpr Env
e Math ()
m = (Reader MathState [TeX] -> MathState -> [TeX])
-> MathState -> Reader MathState [TeX] -> [TeX]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Reader MathState [TeX] -> MathState -> [TeX]
forall r a. Reader r a -> r -> a
runReader (Env -> Bool -> MathState
MathState Env
e Bool
False) (Reader MathState [TeX] -> [TeX])
-> Reader MathState [TeX] -> [TeX]
forall a b. (a -> b) -> a -> b
$ WriterT [TeX] (ReaderT MathState Identity) ()
-> Reader MathState [TeX]
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT (Math () -> WriterT [TeX] (ReaderT MathState Identity) ()
forall a. Math a -> WriterT [TeX] (ReaderT MathState Identity) a
runTeXMath Math ()
m)

data MathState = MathState{ MathState -> Env
mathEnv :: Env
                          , MathState -> Bool
mathConvertible :: Bool
                          } deriving Int -> MathState -> ShowS
[MathState] -> ShowS
MathState -> String
(Int -> MathState -> ShowS)
-> (MathState -> String)
-> ([MathState] -> ShowS)
-> Show MathState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MathState -> ShowS
showsPrec :: Int -> MathState -> ShowS
$cshow :: MathState -> String
show :: MathState -> String
$cshowList :: [MathState] -> ShowS
showList :: [MathState] -> ShowS
Show

setConvertible :: MathState -> MathState
setConvertible :: MathState -> MathState
setConvertible MathState
s = MathState
s{ mathConvertible = True }

newtype Math a = Math {forall a. Math a -> WriterT [TeX] (ReaderT MathState Identity) a
runTeXMath :: WriterT [TeX] (Reader MathState) a}
                  deriving ((forall a b. (a -> b) -> Math a -> Math b)
-> (forall a b. a -> Math b -> Math a) -> Functor Math
forall a b. a -> Math b -> Math a
forall a b. (a -> b) -> Math a -> Math b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Math a -> Math b
fmap :: forall a b. (a -> b) -> Math a -> Math b
$c<$ :: forall a b. a -> Math b -> Math a
<$ :: forall a b. a -> Math b -> Math a
Functor, Functor Math
Functor Math =>
(forall a. a -> Math a)
-> (forall a b. Math (a -> b) -> Math a -> Math b)
-> (forall a b c. (a -> b -> c) -> Math a -> Math b -> Math c)
-> (forall a b. Math a -> Math b -> Math b)
-> (forall a b. Math a -> Math b -> Math a)
-> Applicative Math
forall a. a -> Math a
forall a b. Math a -> Math b -> Math a
forall a b. Math a -> Math b -> Math b
forall a b. Math (a -> b) -> Math a -> Math b
forall a b c. (a -> b -> c) -> Math a -> Math b -> Math c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Math a
pure :: forall a. a -> Math a
$c<*> :: forall a b. Math (a -> b) -> Math a -> Math b
<*> :: forall a b. Math (a -> b) -> Math a -> Math b
$cliftA2 :: forall a b c. (a -> b -> c) -> Math a -> Math b -> Math c
liftA2 :: forall a b c. (a -> b -> c) -> Math a -> Math b -> Math c
$c*> :: forall a b. Math a -> Math b -> Math b
*> :: forall a b. Math a -> Math b -> Math b
$c<* :: forall a b. Math a -> Math b -> Math a
<* :: forall a b. Math a -> Math b -> Math a
Applicative, Applicative Math
Applicative Math =>
(forall a b. Math a -> (a -> Math b) -> Math b)
-> (forall a b. Math a -> Math b -> Math b)
-> (forall a. a -> Math a)
-> Monad Math
forall a. a -> Math a
forall a b. Math a -> Math b -> Math b
forall a b. Math a -> (a -> Math b) -> Math b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. Math a -> (a -> Math b) -> Math b
>>= :: forall a b. Math a -> (a -> Math b) -> Math b
$c>> :: forall a b. Math a -> Math b -> Math b
>> :: forall a b. Math a -> Math b -> Math b
$creturn :: forall a. a -> Math a
return :: forall a. a -> Math a
Monad, MonadReader MathState
                           , MonadWriter [TeX])

getTeXMathM :: T.Text -> Math [TeX]
getTeXMathM :: Text -> Math [TeX]
getTeXMathM Text
s = Text -> Env -> [TeX]
getTeXMath Text
s (Env -> [TeX]) -> Math Env -> Math [TeX]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MathState -> Env) -> Math Env
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MathState -> Env
mathEnv

tellGroup :: Math () -> Math ()
tellGroup :: Math () -> Math ()
tellGroup = ([TeX] -> [TeX]) -> Math () -> Math ()
forall w (m :: * -> *) a. MonadWriter w m => (w -> w) -> m a -> m a
censor ((TeX -> [TeX] -> [TeX]
forall a. a -> [a] -> [a]
:[]) (TeX -> [TeX]) -> ([TeX] -> TeX) -> [TeX] -> [TeX]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TeX] -> TeX
Grouped)

tellGenFrac :: T.Text -> T.Text -> Math ()
tellGenFrac :: Text -> Text -> Math ()
tellGenFrac Text
open Text
close =
  [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [ Text -> TeX
ControlSeq Text
"\\genfrac"
       , [TeX] -> TeX
Grouped [Text -> TeX
Literal Text
open]
       , [TeX] -> TeX
Grouped [Text -> TeX
Literal Text
close]
       , [TeX] -> TeX
Grouped [Text -> TeX
Literal Text
"0pt"]
       , [TeX] -> TeX
Grouped [] ]

writeBinom :: T.Text -> Exp -> Exp -> Math ()
writeBinom :: Text -> Exp -> Exp -> Math ()
writeBinom Text
cmd Exp
x Exp
y = do
  Env
env <- (MathState -> Env) -> Math Env
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MathState -> Env
mathEnv
  if Text
"amsmath" Text -> Env -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Env
env
     then do
       case Text
cmd of
           Text
"\\choose" -> [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text -> TeX
ControlSeq Text
"\\binom"]
           Text
"\\brack"  -> Text -> Text -> Math ()
tellGenFrac Text
"[" Text
"]"
           Text
"\\brace"  -> Text -> Text -> Math ()
tellGenFrac Text
"\\{" Text
"\\}"
           Text
"\\bangle" -> Text -> Text -> Math ()
tellGenFrac Text
"\\langle" Text
"\\rangle"
           Text
_          -> String -> Math ()
forall a. HasCallStack => String -> a
error String
"writeBinom: unknown cmd"
       Math () -> Math ()
tellGroup (Math () -> Math ()) -> Math () -> Math ()
forall a b. (a -> b) -> a -> b
$ Exp -> Math ()
writeExp Exp
x
       Math () -> Math ()
tellGroup (Math () -> Math ()) -> Math () -> Math ()
forall a b. (a -> b) -> a -> b
$ Exp -> Math ()
writeExp Exp
y
     else Math () -> Math ()
tellGroup (Math () -> Math ()) -> Math () -> Math ()
forall a b. (a -> b) -> a -> b
$ do
       Exp -> Math ()
writeExp Exp
x
       [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text -> TeX
ControlSeq Text
cmd]
       Exp -> Math ()
writeExp Exp
y

writeExp :: Exp -> Math ()
writeExp :: Exp -> Math ()
writeExp (ENumber Text
s) = [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([TeX] -> Math ()) -> Math [TeX] -> Math ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Math [TeX]
getTeXMathM Text
s
writeExp (EGrouped [Exp]
es) = Math () -> Math ()
tellGroup ((Exp -> Math ()) -> [Exp] -> Math ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Exp -> Math ()
writeExp [Exp]
es)
writeExp (EDelimited Text
"(" Text
")" [Right (EFraction FractionType
NoLineFrac Exp
x Exp
y)]) =
  Text -> Exp -> Exp -> Math ()
writeBinom Text
"\\choose" Exp
x Exp
y
writeExp (EDelimited Text
"[" Text
"]" [Right (EFraction FractionType
NoLineFrac Exp
x Exp
y)]) = do
  Text -> Exp -> Exp -> Math ()
writeBinom Text
"\\brack" Exp
x Exp
y
writeExp (EDelimited Text
"{" Text
"}" [Right (EFraction FractionType
NoLineFrac Exp
x Exp
y)]) = do
  Text -> Exp -> Exp -> Math ()
writeBinom Text
"\\brace" Exp
x Exp
y
writeExp (EDelimited Text
"\x27E8" Text
"\x27E9" [Right (EFraction FractionType
NoLineFrac Exp
x Exp
y)]) = do
  Text -> Exp -> Exp -> Math ()
writeBinom Text
"\\bangle" Exp
x Exp
y
writeExp (EDelimited Text
open Text
close [Right (EFraction FractionType
NoLineFrac Exp
x Exp
y)]) = do
  Exp -> Math ()
writeExp (Text -> Text -> [InEDelimited] -> Exp
EDelimited Text
open Text
close [Exp -> InEDelimited
forall a b. b -> Either a b
Right ([Alignment] -> [ArrayLine] -> Exp
EArray [Alignment
AlignCenter]
                   [[[Exp
x]],[[Exp
y]]])])
writeExp (EDelimited Text
open Text
close [Right (EArray [Alignment]
aligns [ArrayLine]
rows)]) = do
  Env
env <- (MathState -> Env) -> Math Env
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MathState -> Env
mathEnv
  case (Text
"amsmath" Text -> Env -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Env
env, Text
open, Text
close) of
       (Bool
True, Text
"{", Text
"") | [Alignment]
aligns [Alignment] -> [Alignment] -> Bool
forall a. Eq a => a -> a -> Bool
== [Alignment
AlignLeft, Alignment
AlignLeft] ->
         Text -> [Alignment] -> [ArrayLine] -> Math ()
table Text
"cases" [] [ArrayLine]
rows
       (Bool
True, Text
"(", Text
")") | (Alignment -> Bool) -> [Alignment] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Alignment -> Alignment -> Bool
forall a. Eq a => a -> a -> Bool
== Alignment
AlignCenter) [Alignment]
aligns ->
         Text -> [Alignment] -> [ArrayLine] -> Math ()
table Text
"pmatrix" [] [ArrayLine]
rows
       (Bool
True, Text
"[", Text
"]") | (Alignment -> Bool) -> [Alignment] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Alignment -> Alignment -> Bool
forall a. Eq a => a -> a -> Bool
== Alignment
AlignCenter) [Alignment]
aligns ->
         Text -> [Alignment] -> [ArrayLine] -> Math ()
table Text
"bmatrix" [] [ArrayLine]
rows
       (Bool
True, Text
"{", Text
"}") | (Alignment -> Bool) -> [Alignment] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Alignment -> Alignment -> Bool
forall a. Eq a => a -> a -> Bool
== Alignment
AlignCenter) [Alignment]
aligns ->
         Text -> [Alignment] -> [ArrayLine] -> Math ()
table Text
"Bmatrix" [] [ArrayLine]
rows
       (Bool
True, Text
"\x2223", Text
"\x2223") | (Alignment -> Bool) -> [Alignment] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Alignment -> Alignment -> Bool
forall a. Eq a => a -> a -> Bool
== Alignment
AlignCenter) [Alignment]
aligns ->
         Text -> [Alignment] -> [ArrayLine] -> Math ()
table Text
"vmatrix" [] [ArrayLine]
rows
       (Bool
True, Text
"\x2225", Text
"\x2225") | (Alignment -> Bool) -> [Alignment] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Alignment -> Alignment -> Bool
forall a. Eq a => a -> a -> Bool
== Alignment
AlignCenter) [Alignment]
aligns ->
         Text -> [Alignment] -> [ArrayLine] -> Math ()
table Text
"Vmatrix" [] [ArrayLine]
rows
       (Bool, Text, Text)
_ -> do
         FenceType -> Text -> Math ()
writeDelim FenceType
DLeft Text
open
         Exp -> Math ()
writeExp ([Alignment] -> [ArrayLine] -> Exp
EArray [Alignment]
aligns [ArrayLine]
rows)
         FenceType -> Text -> Math ()
writeDelim FenceType
DRight Text
close
-- this clause is meant to pair with delimitedImplicit in the tex reader:
writeExp (EDelimited Text
open Text
close [InEDelimited]
es)
  | (InEDelimited -> Bool) -> [InEDelimited] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all InEDelimited -> Bool
forall {a}. Either a Exp -> Bool
isStandardHeight [InEDelimited]
es
  , Text
open Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"(" Bool -> Bool -> Bool
|| Text
open Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"[" Bool -> Bool -> Bool
|| Text
open Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"|"
  , Text
close Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
")" Bool -> Bool -> Bool
|| Text
close Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"]" Bool -> Bool -> Bool
|| Text
close Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"|"
  , (InEDelimited -> Bool) -> [InEDelimited] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all InEDelimited -> Bool
forall a b. Either a b -> Bool
isRight [InEDelimited]
es
  = do
    Text -> Math [TeX]
getTeXMathM Text
open Math [TeX] -> ([TeX] -> Math ()) -> Math ()
forall a b. Math a -> (a -> Math b) -> Math b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
    (InEDelimited -> Math ()) -> [InEDelimited] -> Math ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Text -> Math ()) -> (Exp -> Math ()) -> InEDelimited -> Math ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FenceType -> Text -> Math ()
writeDelim FenceType
DMiddle) Exp -> Math ()
writeExp) [InEDelimited]
es
    Text -> Math [TeX]
getTeXMathM Text
close Math [TeX] -> ([TeX] -> Math ()) -> Math ()
forall a b. Math a -> (a -> Math b) -> Math b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
 where
  isStandardHeight :: Either a Exp -> Bool
isStandardHeight (Right (EIdentifier{})) = Bool
True
  isStandardHeight (Right (ENumber{})) = Bool
True
  isStandardHeight (Right (ESpace{})) = Bool
True
  isStandardHeight (Right (ESymbol TeXSymbolType
ty Text
_)) = TeXSymbolType
ty TeXSymbolType -> [TeXSymbolType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TeXSymbolType
Ord, TeXSymbolType
Op, TeXSymbolType
Bin, TeXSymbolType
Rel, TeXSymbolType
Pun]
  isStandardHeight Either a Exp
_ = Bool
False
writeExp (EDelimited Text
open Text
close [InEDelimited]
es) =  do
  FenceType -> Text -> Math ()
writeDelim FenceType
DLeft Text
open
  (InEDelimited -> Math ()) -> [InEDelimited] -> Math ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Text -> Math ()) -> (Exp -> Math ()) -> InEDelimited -> Math ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FenceType -> Text -> Math ()
writeDelim FenceType
DMiddle) Exp -> Math ()
writeExp) [InEDelimited]
es
  FenceType -> Text -> Math ()
writeDelim FenceType
DRight Text
close
writeExp (EIdentifier Text
s) = do
  [TeX]
math <- Text -> Math [TeX]
getTeXMathM Text
s
  case [TeX]
math of
       []      -> () -> Math ()
forall a. a -> Math a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       [TeX
t]     -> [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [TeX
t]
       [TeX]
ts      -> [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [[TeX] -> TeX
Grouped [TeX]
ts]
writeExp o :: Exp
o@(EMathOperator Text
s) = do
  [TeX]
math <- Text -> Math [TeX]
getTeXMathM Text
s
  case Exp -> Maybe TeX
S.getOperator Exp
o of
       Just TeX
op  -> [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [TeX
op]
       Maybe TeX
Nothing  -> do
         [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text -> TeX
ControlSeq Text
"\\operatorname"]
         -- use \operatorname* if convertible
         (MathState -> Bool) -> Math Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MathState -> Bool
mathConvertible Math Bool -> (Bool -> Math ()) -> Math ()
forall a b. Math a -> (a -> Math b) -> Math b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> Math () -> Math ()) -> Math () -> Bool -> Math ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> Math () -> Math ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Char -> TeX
Token Char
'*'])
         [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [[TeX] -> TeX
Grouped [TeX]
math]
writeExp (ESymbol TeXSymbolType
Ord (Text -> String
T.unpack -> [Char
c]))  -- do not render "invisible operators"
  | Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'\x2061'..Char
'\x2064'] = () -> Math ()
forall a. a -> Math a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- see 3.2.5.5 of mathml spec
writeExp (ESymbol TeXSymbolType
t Text
s) = do
  [TeX]
s' <- Text -> Math [TeX]
getTeXMathM Text
s
  Bool -> Math () -> Math ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TeXSymbolType
t TeXSymbolType -> TeXSymbolType -> Bool
forall a. Eq a => a -> a -> Bool
== TeXSymbolType
Bin Bool -> Bool -> Bool
|| TeXSymbolType
t TeXSymbolType -> TeXSymbolType -> Bool
forall a. Eq a => a -> a -> Bool
== TeXSymbolType
Rel) (Math () -> Math ()) -> Math () -> Math ()
forall a b. (a -> b) -> a -> b
$ [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [TeX
Space]
  if Text -> Int
T.length Text
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& (TeXSymbolType
t TeXSymbolType -> TeXSymbolType -> Bool
forall a. Eq a => a -> a -> Bool
== TeXSymbolType
Bin Bool -> Bool -> Bool
|| TeXSymbolType
t TeXSymbolType -> TeXSymbolType -> Bool
forall a. Eq a => a -> a -> Bool
== TeXSymbolType
Rel Bool -> Bool -> Bool
|| TeXSymbolType
t TeXSymbolType -> TeXSymbolType -> Bool
forall a. Eq a => a -> a -> Bool
== TeXSymbolType
Op)
     then [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text -> TeX
ControlSeq (Text
"\\math" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
T.toLower (TeXSymbolType -> Text
forall a. Show a => a -> Text
tshow TeXSymbolType
t)),
                 [TeX] -> TeX
Grouped [Text -> TeX
ControlSeq Text
"\\text", [TeX] -> TeX
Grouped [TeX]
s']]
     else [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [TeX]
s'
  Bool -> Math () -> Math ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TeXSymbolType
t TeXSymbolType -> TeXSymbolType -> Bool
forall a. Eq a => a -> a -> Bool
== TeXSymbolType
Bin Bool -> Bool -> Bool
|| TeXSymbolType
t TeXSymbolType -> TeXSymbolType -> Bool
forall a. Eq a => a -> a -> Bool
== TeXSymbolType
Rel) (Math () -> Math ()) -> Math () -> Math ()
forall a b. (a -> b) -> a -> b
$ [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [TeX
Space]
writeExp (ESpace Rational
width) = do
  Env
env <- (MathState -> Env) -> Math Env
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MathState -> Env
mathEnv
  [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text -> TeX
ControlSeq (Text -> TeX) -> Text -> TeX
forall a b. (a -> b) -> a -> b
$ Bool -> Rational -> Text
getSpaceCommand (Text
"amsmath" Text -> Env -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Env
env) Rational
width]
writeExp (EFraction FractionType
fractype Exp
e1 Exp
e2) = do
  let cmd :: Text
cmd = case FractionType
fractype of
                 FractionType
NormalFrac  -> Text
"\\frac"
                 FractionType
DisplayFrac -> Text
"\\dfrac"
                 FractionType
InlineFrac  -> Text
"\\tfrac"
                 FractionType
NoLineFrac  -> Text
"\\binom"  -- shouldn't happen because
                         -- a binom will be in a delimited
  [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text -> TeX
ControlSeq Text
cmd]
  Math () -> Math ()
tellGroup (Exp -> Math ()
writeExp Exp
e1)
  Math () -> Math ()
tellGroup (Exp -> Math ()
writeExp Exp
e2)
writeExp (ESub Exp
b Exp
e1) = do
  (if Exp -> Bool
isFancy Exp
b then Math () -> Math ()
tellGroup else Math () -> Math ()
forall a. a -> a
id) (Math () -> Math ()) -> Math () -> Math ()
forall a b. (a -> b) -> a -> b
$ Exp -> Math ()
writeExp Exp
b
  [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Char -> TeX
Token Char
'_']
  Math () -> Math ()
tellGroup (Exp -> Math ()
writeExp Exp
e1)
writeExp (ESuper Exp
b Exp
e1) = do
  (if Exp -> Bool
isFancy Exp
b then Math () -> Math ()
tellGroup else Math () -> Math ()
forall a. a -> a
id) (Math () -> Math ()) -> Math () -> Math ()
forall a b. (a -> b) -> a -> b
$ Exp -> Math ()
writeExp Exp
b
  [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Char -> TeX
Token Char
'^']
  Math () -> Math ()
tellGroup (Exp -> Math ()
writeExp Exp
e1)
writeExp (ESubsup Exp
b Exp
e1 Exp
e2) = do
  (if Exp -> Bool
isFancy Exp
b then Math () -> Math ()
tellGroup else Math () -> Math ()
forall a. a -> a
id) (Math () -> Math ()) -> Math () -> Math ()
forall a b. (a -> b) -> a -> b
$ Exp -> Math ()
writeExp Exp
b
  [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Char -> TeX
Token Char
'_']
  Math () -> Math ()
tellGroup (Exp -> Math ()
writeExp Exp
e1)
  [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Char -> TeX
Token Char
'^']
  Math () -> Math ()
tellGroup (Exp -> Math ()
writeExp Exp
e2)
writeExp (EOver Bool
convertible Exp
b Exp
e1) = do
  Env
env <- (MathState -> Env) -> Math Env
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MathState -> Env
mathEnv
  case Exp -> Maybe TeX
xarrow Exp
b of
    Just TeX
arrowCtrlSeq | Text
"amsmath" Text -> Env -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Env
env -> do
      [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [TeX
arrowCtrlSeq]
      Math () -> Math ()
tellGroup (Exp -> Math ()
writeExp Exp
e1)
    Maybe TeX
_ -> Position -> Bool -> Exp -> Exp -> Math ()
writeScript Position
Over Bool
convertible Exp
b Exp
e1
writeExp (EUnder Bool
convertible Exp
b Exp
e1) =
  Position -> Bool -> Exp -> Exp -> Math ()
writeScript Position
Under Bool
convertible Exp
b Exp
e1
writeExp (EUnderover Bool
convertible Exp
b e1 :: Exp
e1@(ESymbol TeXSymbolType
Accent Text
_) Exp
e2) =
 Exp -> Math ()
writeExp (Bool -> Exp -> Exp -> Exp
EUnder Bool
convertible (Bool -> Exp -> Exp -> Exp
EOver Bool
False Exp
b Exp
e2) Exp
e1)
writeExp (EUnderover Bool
convertible Exp
b Exp
e1 e2 :: Exp
e2@(ESymbol TeXSymbolType
Accent Text
_)) =
 Exp -> Math ()
writeExp (Bool -> Exp -> Exp -> Exp
EOver Bool
convertible (Bool -> Exp -> Exp -> Exp
EUnder Bool
False Exp
b Exp
e1) Exp
e2)
writeExp (EUnderover Bool
convertible Exp
b Exp
e1 Exp
e2) = do
  Env
env <- (MathState -> Env) -> Math Env
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MathState -> Env
mathEnv
  case Exp -> Maybe TeX
xarrow Exp
b of
    Just TeX
arrowCtrlSeq | Text
"amsmath" Text -> Env -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Env
env -> do
      [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [TeX
arrowCtrlSeq]
      [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Char -> TeX
Token Char
'[']
      Math () -> Math ()
tellGroup (Math () -> Math ()) -> Math () -> Math ()
forall a b. (a -> b) -> a -> b
$ Exp -> Math ()
writeExp Exp
e1
      [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Char -> TeX
Token Char
']']
      Math () -> Math ()
tellGroup (Exp -> Math ()
writeExp Exp
e2)
    Maybe TeX
Nothing
      | Exp -> Bool
isOperator Exp
b -> do
          (if Exp -> Bool
isFancy Exp
b then Math () -> Math ()
tellGroup else Math () -> Math ()
forall a. a -> a
id) (Math () -> Math ()) -> Math () -> Math ()
forall a b. (a -> b) -> a -> b
$
            (if Bool
convertible then (MathState -> MathState) -> Math () -> Math ()
forall a. (MathState -> MathState) -> Math a -> Math a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local MathState -> MathState
setConvertible else Math () -> Math ()
forall a. a -> a
id) (Math () -> Math ()) -> Math () -> Math ()
forall a b. (a -> b) -> a -> b
$ Exp -> Math ()
writeExp Exp
b
          Bool -> Math () -> Math ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
convertible (Math () -> Math ()) -> Math () -> Math ()
forall a b. (a -> b) -> a -> b
$ [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text -> TeX
ControlSeq Text
"\\limits"]
          [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Char -> TeX
Token Char
'_']
          Math () -> Math ()
tellGroup (Exp -> Math ()
checkSubstack Exp
e1)
          [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Char -> TeX
Token Char
'^']
          Math () -> Math ()
tellGroup (Exp -> Math ()
checkSubstack Exp
e2)
    Maybe TeX
_ -> Exp -> Math ()
writeExp (Bool -> Exp -> Exp -> Exp
EUnder Bool
convertible (Bool -> Exp -> Exp -> Exp
EOver Bool
convertible Exp
b Exp
e2) Exp
e1)
writeExp (ESqrt Exp
e) = do
    [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text -> TeX
ControlSeq Text
"\\sqrt"]
    Math () -> Math ()
tellGroup (Exp -> Math ()
writeExp Exp
e)
writeExp (ERoot Exp
i Exp
e) = do
    [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text -> TeX
ControlSeq Text
"\\sqrt"]
    [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Char -> TeX
Token Char
'[']
    Exp -> Math ()
writeExp Exp
i
    [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Char -> TeX
Token Char
']']
    Math () -> Math ()
tellGroup (Exp -> Math ()
writeExp Exp
e)
writeExp (EPhantom Exp
e) = do
    [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text -> TeX
ControlSeq Text
"\\phantom"]
    Math () -> Math ()
tellGroup (Exp -> Math ()
writeExp Exp
e)
writeExp (EBoxed Exp
e) = do
    Env
env <- (MathState -> Env) -> Math Env
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MathState -> Env
mathEnv
    if Text
"amsmath" Text -> Env -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Env
env
      then do
        [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text -> TeX
ControlSeq Text
"\\boxed"]
        Math () -> Math ()
tellGroup (Exp -> Math ()
writeExp Exp
e)
      else Exp -> Math ()
writeExp Exp
e
writeExp (EScaled Rational
size Exp
e)
  | case Exp
e of
         (ESymbol TeXSymbolType
Open Text
_)  -> Bool
True
         (ESymbol TeXSymbolType
Close Text
_) -> Bool
True
         Exp
_ -> Bool
False = do
    case Rational -> Maybe Text
S.getScalerCommand Rational
size of
         Just Text
s  -> [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text -> TeX
ControlSeq Text
s]
         Maybe Text
Nothing -> () -> Math ()
forall a. a -> Math a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Exp -> Math ()
writeExp Exp
e
  | Bool
otherwise = Exp -> Math ()
writeExp Exp
e
writeExp (EText TextType
ttype Text
s) = do
  let txtcmd :: TeX -> [TeX]
txtcmd = TextType -> TeX -> [TeX]
getTextCommand TextType
ttype
  let fixSpace :: TeX -> TeX
fixSpace (Literal Text
"\\ ") = Text -> TeX
Literal Text
" "
      fixSpace TeX
x = TeX
x
  case (Char -> TeX) -> String -> [TeX]
forall a b. (a -> b) -> [a] -> [b]
map (TeX -> TeX
fixSpace (TeX -> TeX) -> (Char -> TeX) -> Char -> TeX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> TeX
escapeLaTeX) (Text -> String
T.unpack Text
s) of
       []   -> () -> Math ()
forall a. a -> Math a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       [TeX]
xs   -> [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([TeX] -> Math ()) -> [TeX] -> Math ()
forall a b. (a -> b) -> a -> b
$ TeX -> [TeX]
txtcmd ([TeX] -> TeX
Grouped [TeX]
xs)
writeExp (EStyled TextType
TextNormal [EStyled TextType
TextBold [Exp]
es]) = do
  [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text -> TeX
ControlSeq Text
"\\mathbf"]
  Math () -> Math ()
tellGroup (Math () -> Math ()) -> Math () -> Math ()
forall a b. (a -> b) -> a -> b
$ (Exp -> Math ()) -> [Exp] -> Math ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Exp -> Math ()
writeExp ([Exp] -> Math ()) -> [Exp] -> Math ()
forall a b. (a -> b) -> a -> b
$ (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere ((Text -> Text) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT (TextType -> Text -> Text
fromUnicode TextType
TextBold)) [Exp]
es
writeExp (EStyled TextType
ttype [Exp]
es) = do
  Text
txtcmd <- ((Env -> TextType -> Text) -> TextType -> Env -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Env -> TextType -> Text
S.getLaTeXTextCommand TextType
ttype) (Env -> Text) -> Math Env -> Math Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MathState -> Env) -> Math Env
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MathState -> Env
mathEnv
  [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text -> TeX
ControlSeq Text
txtcmd]
  Math () -> Math ()
tellGroup ((Exp -> Math ()) -> [Exp] -> Math ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Exp -> Math ()
writeExp ([Exp] -> Math ()) -> [Exp] -> Math ()
forall a b. (a -> b) -> a -> b
$ (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere ((Text -> Text) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT (TextType -> Text -> Text
fromUnicode TextType
ttype)) [Exp]
es)
writeExp (EArray [Alignment]
as [ArrayLine]
rows)
  | [Alignment] -> Bool
isRLSequence [Alignment]
as = do
  Env
env <- (MathState -> Env) -> Math Env
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MathState -> Env
mathEnv
  if Text
"amsmath" Text -> Env -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Env
env
     then Text -> [Alignment] -> [ArrayLine] -> Math ()
table Text
"aligned" [] [ArrayLine]
rows
     else Text -> [Alignment] -> [ArrayLine] -> Math ()
table Text
"array" [Alignment]
as [ArrayLine]
rows
writeExp (EArray [Alignment]
aligns [ArrayLine]
rows) = do
  Env
env <- (MathState -> Env) -> Math Env
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MathState -> Env
mathEnv
  if Text
"amsmath" Text -> Env -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Env
env Bool -> Bool -> Bool
&& (Alignment -> Bool) -> [Alignment] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Alignment -> Alignment -> Bool
forall a. Eq a => a -> a -> Bool
== Alignment
AlignCenter) [Alignment]
aligns
     then Text -> [Alignment] -> [ArrayLine] -> Math ()
table Text
"matrix" [] [ArrayLine]
rows
     else Text -> [Alignment] -> [ArrayLine] -> Math ()
table Text
"array" [Alignment]
aligns [ArrayLine]
rows

isRLSequence :: [Alignment] -> Bool
isRLSequence :: [Alignment] -> Bool
isRLSequence [Alignment
AlignRight, Alignment
AlignLeft] = Bool
True
isRLSequence (Alignment
AlignRight : Alignment
AlignLeft : [Alignment]
as) = [Alignment] -> Bool
isRLSequence [Alignment]
as
isRLSequence [Alignment]
_ = Bool
False

table :: T.Text -> [Alignment] -> [ArrayLine] -> Math ()
table :: Text -> [Alignment] -> [ArrayLine] -> Math ()
table Text
name [Alignment]
aligns [ArrayLine]
rows = do
  [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text -> TeX
ControlSeq Text
"\\begin", [TeX] -> TeX
Grouped [Text -> TeX
Literal Text
name]]
  Bool -> Math () -> Math ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Alignment] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Alignment]
aligns) (Math () -> Math ()) -> Math () -> Math ()
forall a b. (a -> b) -> a -> b
$
     [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [[TeX] -> TeX
Grouped [Text -> TeX
Literal Text
columnAligns]]
  [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Char -> TeX
Token Char
'\n']
  [ArrayLine] -> Math ()
doRows [ArrayLine]
rows
  [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text -> TeX
ControlSeq Text
"\\end", [TeX] -> TeX
Grouped [Text -> TeX
Literal Text
name]]
  where
    columnAligns :: Text
columnAligns = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (Alignment -> Char) -> [Alignment] -> String
forall a b. (a -> b) -> [a] -> [b]
map Alignment -> Char
alignmentToLetter [Alignment]
aligns
    alignmentToLetter :: Alignment -> Char
alignmentToLetter Alignment
AlignLeft = Char
'l'
    alignmentToLetter Alignment
AlignCenter = Char
'c'
    alignmentToLetter Alignment
AlignRight = Char
'r'

doRows :: [ArrayLine] -> Math ()
doRows :: [ArrayLine] -> Math ()
doRows []          = () -> Math ()
forall a. a -> Math a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
doRows ([]:[])     = [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Char -> TeX
Token Char
'\n']
doRows ([]:[ArrayLine]
ls)     = [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [TeX
Space, Text -> TeX
Literal Text
"\\\\", Char -> TeX
Token Char
'\n'] Math () -> Math () -> Math ()
forall a b. Math a -> Math b -> Math b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [ArrayLine] -> Math ()
doRows [ArrayLine]
ls
doRows ([[Exp]
c]:[ArrayLine]
ls)    = [Exp] -> Math ()
cell [Exp]
c Math () -> Math () -> Math ()
forall a b. Math a -> Math b -> Math b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [ArrayLine] -> Math ()
doRows ([]ArrayLine -> [ArrayLine] -> [ArrayLine]
forall a. a -> [a] -> [a]
:[ArrayLine]
ls)
doRows (([Exp]
c:ArrayLine
cs):[ArrayLine]
ls) = [Exp] -> Math ()
cell [Exp]
c Math () -> Math () -> Math ()
forall a b. Math a -> Math b -> Math b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [TeX
Space, Char -> TeX
Token Char
'&', TeX
Space] Math () -> Math () -> Math ()
forall a b. Math a -> Math b -> Math b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [ArrayLine] -> Math ()
doRows (ArrayLine
csArrayLine -> [ArrayLine] -> [ArrayLine]
forall a. a -> [a] -> [a]
:[ArrayLine]
ls)

cell :: [Exp] -> Math ()
cell :: [Exp] -> Math ()
cell = (Exp -> Math ()) -> [Exp] -> Math ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Exp -> Math ()
writeExp

data FenceType = DLeft | DMiddle | DRight

type Delim = T.Text

writeDelim :: FenceType -> Delim -> Math ()
writeDelim :: FenceType -> Text -> Math ()
writeDelim FenceType
fence Text
delim = do
    [TeX]
tex <- Text -> Math [TeX]
getTeXMathM Text
delim
    Bool
valid <- [TeX] -> [[TeX]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [TeX]
tex ([[TeX]] -> Bool) -> Math [[TeX]] -> Math Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Math [[TeX]]
delimiters
    [TeX]
nullLim <- Text -> Math [TeX]
getTeXMathM Text
"."
    let delimCmd :: [TeX]
delimCmd = if Bool
valid then [TeX]
tex else [TeX]
nullLim
    [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([TeX] -> Math ()) -> [TeX] -> Math ()
forall a b. (a -> b) -> a -> b
$ case FenceType
fence of
             FenceType
DLeft -> [Text -> TeX
ControlSeq Text
"\\left"] [TeX] -> [TeX] -> [TeX]
forall a. [a] -> [a] -> [a]
++ [TeX]
delimCmd [TeX] -> [TeX] -> [TeX]
forall a. [a] -> [a] -> [a]
++ [TeX
Space] [TeX] -> [TeX] -> [TeX]
forall a. [a] -> [a] -> [a]
++ if Bool
valid then [] else [TeX]
tex
             FenceType
DMiddle -> case Bool
valid of
                              Bool
True -> [TeX
Space] [TeX] -> [TeX] -> [TeX]
forall a. [a] -> [a] -> [a]
++ [Text -> TeX
ControlSeq Text
"\\middle"] [TeX] -> [TeX] -> [TeX]
forall a. [a] -> [a] -> [a]
++ [TeX]
tex [TeX] -> [TeX] -> [TeX]
forall a. [a] -> [a] -> [a]
++ [TeX
Space]
                              Bool
False -> [TeX]
tex
             FenceType
DRight -> [TeX
Space, Text -> TeX
ControlSeq Text
"\\right"] [TeX] -> [TeX] -> [TeX]
forall a. [a] -> [a] -> [a]
++ [TeX]
delimCmd [TeX] -> [TeX] -> [TeX]
forall a. [a] -> [a] -> [a]
++ if Bool
valid then [] else [TeX]
tex

writeScript :: Position -> Bool -> Exp -> Exp -> Math ()
writeScript :: Position -> Bool -> Exp -> Exp -> Math ()
writeScript Position
pos Bool
convertible Exp
b Exp
e1 = do
  let diacmd :: Maybe Text
diacmd = case Exp
e1 of
                    ESymbol TeXSymbolType
stype Text
a
                      | TeXSymbolType
stype TeXSymbolType -> [TeXSymbolType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TeXSymbolType
Accent, TeXSymbolType
TOver, TeXSymbolType
TUnder]
                      -> Position -> Text -> Maybe Text
S.getDiacriticalCommand Position
pos Text
a
                    Exp
_ -> Maybe Text
forall a. Maybe a
Nothing
  case Maybe Text
diacmd of
       Just Text
cmd -> do
            [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text -> TeX
ControlSeq Text
cmd]
            Math () -> Math ()
tellGroup (Exp -> Math ()
writeExp Exp
b)
       Maybe Text
Nothing
         | Exp -> Bool
isOperator Exp
b -> do
            (if Exp -> Bool
isFancy Exp
b then Math () -> Math ()
tellGroup else Math () -> Math ()
forall a. a -> a
id) (Math () -> Math ()) -> Math () -> Math ()
forall a b. (a -> b) -> a -> b
$
              (if Bool
convertible then (MathState -> MathState) -> Math () -> Math ()
forall a. (MathState -> MathState) -> Math a -> Math a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local MathState -> MathState
setConvertible else Math () -> Math ()
forall a. a -> a
id) (Math () -> Math ()) -> Math () -> Math ()
forall a b. (a -> b) -> a -> b
$ Exp -> Math ()
writeExp Exp
b
            Bool -> Math () -> Math ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
convertible (Math () -> Math ()) -> Math () -> Math ()
forall a b. (a -> b) -> a -> b
$ [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text -> TeX
ControlSeq Text
"\\limits"]
            [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Char -> TeX
Token (Char -> TeX) -> Char -> TeX
forall a b. (a -> b) -> a -> b
$ case Position
pos of { Position
Over -> Char
'^'; Position
Under -> Char
'_' }]
            Math () -> Math ()
tellGroup (Exp -> Math ()
checkSubstack Exp
e1)
         | case Position
pos of {Position
Over -> Bool
True; Position
_ -> Bool
False}
         , Exp
e1 Exp -> Exp -> Bool
forall a. Eq a => a -> a -> Bool
== TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Accent Text
"\831" -> do -- double bar
            [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text -> TeX
ControlSeq Text
"\\overline", Text -> TeX
Literal Text
"{",
                  Text -> TeX
ControlSeq Text
"\\overline"]
            Math () -> Math ()
tellGroup (Exp -> Math ()
writeExp Exp
b)
            [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text -> TeX
Literal Text
"}"]
         | Bool
otherwise -> do
             case Position
pos of
                  Position
Over   -> [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text -> TeX
ControlSeq Text
"\\overset"]
                  Position
Under  -> [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text -> TeX
ControlSeq Text
"\\underset"]
             Math () -> Math ()
tellGroup (Exp -> Math ()
writeExp Exp
e1)
             Math () -> Math ()
tellGroup (Exp -> Math ()
writeExp Exp
b)

-- Replace an array with a substack if appropriate.
checkSubstack :: Exp -> Math ()
checkSubstack :: Exp -> Math ()
checkSubstack e :: Exp
e@(EArray [Alignment
AlignCenter] [ArrayLine]
rows) = do
  Env
env <- (MathState -> Env) -> Math Env
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MathState -> Env
mathEnv
  if Text
"amsmath" Text -> Env -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Env
env
     then do
       [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text -> TeX
ControlSeq Text
"\\substack"]
       Math () -> Math ()
tellGroup (Math () -> Math ()) -> Math () -> Math ()
forall a b. (a -> b) -> a -> b
$ (Bool -> ArrayLine -> Math Bool) -> Bool -> [ArrayLine] -> Math ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ (\Bool
first ArrayLine
r -> do
          if Bool
first
             then () -> Math ()
forall a. a -> Math a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
             else [TeX] -> Math ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [TeX
Space, Text -> TeX
Literal Text
"\\\\", TeX
Space]
          ([Exp] -> Math ()) -> ArrayLine -> Math ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Exp -> Math ()) -> [Exp] -> Math ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Exp -> Math ()
writeExp ([Exp] -> Math ()) -> ([Exp] -> [Exp]) -> [Exp] -> Math ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Exp] -> [Exp]
removeOuterGroup) ArrayLine
r
          Bool -> Math Bool
forall a. a -> Math a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) Bool
True [ArrayLine]
rows
     else Exp -> Math ()
writeExp Exp
e
checkSubstack Exp
e = Exp -> Math ()
writeExp Exp
e

-- Utility

-- | Maps a length in em to the nearest LaTeX space command
getSpaceCommand :: Bool -> Rational -> T.Text
getSpaceCommand :: Bool -> Rational -> Text
getSpaceCommand Bool
amsmath Rational
width =
  case Rational -> Int
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational
width Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
18) :: Int of
          -3       -> Text
"\\!"
          Int
0        -> Text
""
          Int
3        -> Text
"\\,"
          Int
4        -> Text
"\\ "  -- could also use \: or \>
          Int
5        -> Text
"\\;"
          Int
18       -> Text
"\\quad"
          Int
36       -> Text
"\\qquad"
          Int
n        -> if Bool
amsmath
                         then Text
"\\mspace{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"mu}"
                         else Text
"{\\mskip " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"mu}"

getTextCommand :: TextType -> TeX -> [TeX]
getTextCommand :: TextType -> TeX -> [TeX]
getTextCommand TextType
tt TeX
x =
  case TextType
tt of
        TextType
TextNormal     -> [Text -> TeX
ControlSeq Text
"\\text", TeX
x]
        TextType
TextItalic     -> [Text -> TeX
ControlSeq Text
"\\textit", TeX
x]
        TextType
TextBold       -> [Text -> TeX
ControlSeq Text
"\\textbf", TeX
x]
        TextType
TextMonospace  -> [Text -> TeX
ControlSeq Text
"\\texttt", TeX
x]
        TextType
TextBoldItalic -> [Text -> TeX
ControlSeq Text
"\\textit",
                             [TeX] -> TeX
Grouped [Text -> TeX
ControlSeq Text
"\\textbf", TeX
x]]
        TextType
TextSansSerif  -> [Text -> TeX
ControlSeq Text
"\\textsf", TeX
x]
        TextType
TextSansSerifBold -> [Text -> TeX
ControlSeq Text
"\\textbf",
                               [TeX] -> TeX
Grouped [Text -> TeX
ControlSeq Text
"\\textsf", TeX
x]]
        TextType
TextSansSerifItalic -> [Text -> TeX
ControlSeq Text
"\\textit",
                                [TeX] -> TeX
Grouped [Text -> TeX
ControlSeq Text
"\\textsf", TeX
x]]
        TextType
TextSansSerifBoldItalic -> [Text -> TeX
ControlSeq Text
"\\textbf",
                                    [TeX] -> TeX
Grouped [Text -> TeX
ControlSeq Text
"\\textit",
                                      [TeX] -> TeX
Grouped [Text -> TeX
ControlSeq Text
"\\textsf", TeX
x]]]
        TextType
_  -> [Text -> TeX
ControlSeq Text
"\\text", TeX
x]

xarrow :: Exp -> Maybe TeX
xarrow :: Exp -> Maybe TeX
xarrow (ESymbol TeXSymbolType
Op Text
"\x2190") = TeX -> Maybe TeX
forall a. a -> Maybe a
Just (TeX -> Maybe TeX) -> TeX -> Maybe TeX
forall a b. (a -> b) -> a -> b
$ Text -> TeX
ControlSeq Text
"\\xleftarrow"
xarrow (ESymbol TeXSymbolType
Op Text
"\x2192") = TeX -> Maybe TeX
forall a. a -> Maybe a
Just (TeX -> Maybe TeX) -> TeX -> Maybe TeX
forall a b. (a -> b) -> a -> b
$ Text -> TeX
ControlSeq Text
"\\xrightarrow"
xarrow Exp
_ = Maybe TeX
forall a. Maybe a
Nothing

-- Commands which can be used with \left and \right
delimiters :: Math [[TeX]]
delimiters :: Math [[TeX]]
delimiters = do
    Env
env <- (MathState -> Env) -> Math Env
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks MathState -> Env
mathEnv
    let commands' :: Env
commands' = [ Text
".", Text
"(", Text
")", Text
"[", Text
"]", Text
"|", Text
"\x2016", Text
"{", Text
"}"
                    , Text
"\x2309", Text
"\x2308", Text
"\x2329", Text
"\x232A"
                    , Text
"\x230B", Text
"\x230A", Text
"\x231C", Text
"\x231D"]
    [[TeX]] -> Math [[TeX]]
forall a. a -> Math a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[TeX]] -> Math [[TeX]]) -> [[TeX]] -> Math [[TeX]]
forall a b. (a -> b) -> a -> b
$ ([TeX] -> Bool) -> [[TeX]] -> [[TeX]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([TeX] -> Bool) -> [TeX] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TeX] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ((Text -> [TeX]) -> Env -> [[TeX]]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Env -> [TeX]) -> Env -> Text -> [TeX]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Env -> [TeX]
getTeXMath Env
env) Env
commands')

isFancy :: Exp -> Bool
isFancy :: Exp -> Bool
isFancy (ESub Exp
_ Exp
_) = Bool
True
isFancy (ESuper Exp
_ Exp
_) = Bool
True
isFancy (ESubsup Exp
_ Exp
_ Exp
_) = Bool
True
isFancy (EOver Bool
_ Exp
_ Exp
_) = Bool
True
isFancy (EUnder Bool
_ Exp
_ Exp
_) = Bool
True
isFancy (EUnderover Bool
_ Exp
_ Exp
_ Exp
_) = Bool
True
isFancy (ESqrt Exp
_) = Bool
True
isFancy (ERoot Exp
_ Exp
_) = Bool
True
isFancy (EPhantom Exp
_) = Bool
True
isFancy Exp
_ = Bool
False

isOperator :: Exp -> Bool
isOperator :: Exp -> Bool
isOperator (EMathOperator Text
_) = Bool
True
isOperator (ESymbol TeXSymbolType
Op Text
_)    = Bool
True
isOperator Exp
_                 = Bool
False

removeOuterGroup :: [Exp] -> [Exp]
removeOuterGroup :: [Exp] -> [Exp]
removeOuterGroup [EGrouped [Exp]
es] = [Exp]
es
removeOuterGroup [Exp]
es = [Exp]
es

tshow :: Show a => a -> T.Text
tshow :: forall a. Show a => a -> Text
tshow = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show