{-# LANGUAGE GeneralizedNewtypeDeriving, ViewPatterns, GADTs, OverloadedStrings #-}
module Text.TeXMath.Writers.Eqn (writeEqn) where
import Data.List (transpose)
import Data.Char (isAscii, ord)
import qualified Data.Text as T
import Text.Printf (printf)
import Text.TeXMath.Types
import qualified Text.TeXMath.Shared as S
import Data.Generics (everywhere, mkT)
import Data.Ratio ((%))
import Data.Semigroup ((<>))
writeEqn :: DisplayType -> [Exp] -> T.Text
writeEqn :: DisplayType -> [Exp] -> Text
writeEqn dt :: DisplayType
dt exprs :: [Exp]
exprs =
Text -> [Text] -> Text
T.intercalate " " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Exp -> Text) -> [Exp] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Text
writeExp ([Exp] -> [Text]) -> [Exp] -> [Text]
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
S.handleDownup DisplayType
dt) [Exp]
exprs
writeExp' :: Exp -> T.Text
writeExp' :: Exp -> Text
writeExp' e :: Exp
e@(EGrouped _) = Exp -> Text
writeExp Exp
e
writeExp' e :: Exp
e = if (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ') Text
s
then "{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "}"
else Text
s
where s :: Text
s = Exp -> Text
writeExp Exp
e
writeExps :: [Exp] -> T.Text
writeExps :: [Exp] -> Text
writeExps = Text -> [Text] -> Text
T.intercalate " " ([Text] -> Text) -> ([Exp] -> [Text]) -> [Exp] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp -> Text) -> [Exp] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> Text
writeExp
writeExp :: Exp -> T.Text
writeExp :: Exp -> Text
writeExp (ENumber s :: Text
s) = Text
s
writeExp (EGrouped es :: [Exp]
es) = "{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Exp] -> Text
writeExps [Exp]
es Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "}"
writeExp (EDelimited open :: Text
open close :: Text
close es :: [InEDelimited]
es) =
"left " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall p. (Eq p, IsString p) => p -> p
mbQuote Text
open Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate " " ((InEDelimited -> Text) -> [InEDelimited] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map InEDelimited -> Text
fromDelimited [InEDelimited]
es) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
" right " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall p. (Eq p, IsString p) => p -> p
mbQuote Text
close
where fromDelimited :: InEDelimited -> Text
fromDelimited (Left e :: Text
e) = "\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\""
fromDelimited (Right e :: Exp
e) = Exp -> Text
writeExp Exp
e
mbQuote :: p -> p
mbQuote "" = "\"\""
mbQuote s :: p
s = p
s
writeExp (EMathOperator s :: Text
s) =
if Text
s Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["sin", "cos", "tan", "sinh", "cosh",
"tanh", "arc", "max", "min", "lim",
"log", "ln", "exp"]
then Text
s
else "\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\""
writeExp (ESymbol Ord (Text -> String
T.unpack -> [c :: Char
c]))
| Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ['\x2061'..'\x2064'] = ""
writeExp (EIdentifier s :: Text
s) = Exp -> Text
writeExp (TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Ord Text
s)
writeExp (ESymbol t :: TeXSymbolType
t s :: Text
s) =
case Text
s of
"{" -> "\\[lC]"
"}" -> "\\[rC]"
"\8805" -> ">="
"\8804" -> "<="
"\8801" -> "=="
"\8800" -> "!="
"\177" -> "+-"
"\8594" -> "->"
"\8592" -> "<-"
"\8810" -> "<<"
"\8811" -> ">>"
"\8734" -> "inf"
"\8706" -> "partial"
"\189" -> "half"
"\8242" -> "prime"
"\8776" -> "approx"
"\183" -> "cdot"
"\215" -> "times"
"\8711" -> "grad"
"\8230" -> "..."
"\8721" -> "sum"
"\8747" -> "int"
"\8719" -> "prod"
"\8898" -> "union"
"\8899" -> "inter"
"\945" -> "alpha"
"\946" -> "beta"
"\967" -> "chi"
"\948" -> "delta"
"\916" -> "DELTA"
"\1013" -> "epsilon"
"\951" -> "eta"
"\947" -> "gamma"
"\915" -> "GAMMA"
"\953" -> "iota"
"\954" -> "kappa"
"\955" -> "lambda"
"\923" -> "LAMBDA"
"\956" -> "mu"
"\957" -> "nu"
"\969" -> "omega"
"\937" -> "OMEGA"
"\981" -> "phi"
"\966" -> "varphi"
"\934" -> "PHI"
"\960" -> "pi"
"\928" -> "PI"
"\968" -> "psi"
"\936" -> "PSI"
"\961" -> "rho"
"\963" -> "sigma"
"\931" -> "SIGMA"
"\964" -> "tau"
"\952" -> "theta"
"\920" -> "THETA"
"\965" -> "upsilon"
"\933" -> "UPSILON"
"\958" -> "xi"
"\926" -> "XI"
"\950" -> "zeta"
_ -> let s' :: Text
s' = if (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAscii Text
s
then Text
s
else "\\[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords ((Char -> Text) -> String -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Text
toUchar (String -> [Text]) -> String -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "]"
toUchar :: Char -> Text
toUchar c :: Char
c = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
forall r. PrintfType r => String -> r
printf "u%04X" (Char -> Int
ord Char
c)
in if Text -> Int
T.length Text
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 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
Bin Bool -> Bool -> Bool
|| TeXSymbolType
t TeXSymbolType -> TeXSymbolType -> Bool
forall a. Eq a => a -> a -> Bool
== TeXSymbolType
Op)
then "roman{\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
(if 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
Bin
then " "
else "") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
s' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
(if 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
Bin Bool -> Bool -> Bool
|| TeXSymbolType
t TeXSymbolType -> TeXSymbolType -> Bool
forall a. Eq a => a -> a -> Bool
== TeXSymbolType
Op
then " "
else "") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
"\"}"
else Text
s'
writeExp (ESpace d :: Rational
d) =
case Rational
d of
_ | Rational
d Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& Rational
d Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< (2 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% 9) -> "^"
| Rational
d Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= (2 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% 9) Bool -> Bool -> Bool
&& Rational
d Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< (3 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% 9) -> "~"
| Rational
d Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< 0 -> "back " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (Rational -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (-1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
d Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* 100) :: Int)
| Bool
otherwise -> "fwd " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (Rational -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational
d Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* 100) :: Int)
writeExp (EFraction fractype :: FractionType
fractype e1 :: Exp
e1 e2 :: Exp
e2) = Exp -> Text
writeExp' Exp
e1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
op Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp' Exp
e2
where op :: Text
op = if FractionType
fractype FractionType -> FractionType -> Bool
forall a. Eq a => a -> a -> Bool
== FractionType
NoLineFrac
then " / "
else " over "
writeExp (ESub b :: Exp
b e1 :: Exp
e1) = Exp -> Text
writeExp' Exp
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " sub " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp' Exp
e1
writeExp (ESuper b :: Exp
b e1 :: Exp
e1) = Exp -> Text
writeExp' Exp
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " sup " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp' Exp
e1
writeExp (ESubsup b :: Exp
b e1 :: Exp
e1 e2 :: Exp
e2) =
Exp -> Text
writeExp' Exp
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " sub " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp' Exp
e1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " sup " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp' Exp
e2
writeExp (EOver _convertible :: Bool
_convertible b :: Exp
b e1 :: Exp
e1) =
Exp -> Text
writeExp' Exp
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp' Exp
e1
writeExp (EUnder _convertible :: Bool
_convertible b :: Exp
b e1 :: Exp
e1) =
Exp -> Text
writeExp' Exp
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp' Exp
e1
writeExp (EUnderover convertible :: Bool
convertible b :: Exp
b e1 :: Exp
e1@(ESymbol Accent _) e2 :: Exp
e2) =
Exp -> Text
writeExp (Bool -> Exp -> Exp -> Exp
EUnder Bool
convertible (Bool -> Exp -> Exp -> Exp
EOver Bool
False Exp
b Exp
e2) Exp
e1)
writeExp (EUnderover convertible :: Bool
convertible b :: Exp
b e1 :: Exp
e1 e2 :: Exp
e2@(ESymbol Accent _)) =
Exp -> Text
writeExp (Bool -> Exp -> Exp -> Exp
EOver Bool
convertible (Bool -> Exp -> Exp -> Exp
EUnder Bool
False Exp
b Exp
e1) Exp
e2)
writeExp (EUnderover _convertible :: Bool
_convertible b :: Exp
b e1 :: Exp
e1 e2 :: Exp
e2) =
Exp -> Text
writeExp' Exp
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp' Exp
e1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp' Exp
e2
writeExp (ESqrt e :: Exp
e) = "sqrt " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp' Exp
e
writeExp (ERoot i :: Exp
i e :: Exp
e) = "\"\" sup " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp' Exp
i Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " sqrt " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp' Exp
e
writeExp (EPhantom e :: Exp
e) = "hphantom " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp' Exp
e
writeExp (EBoxed e :: Exp
e) = Exp -> Text
writeExp Exp
e
writeExp (EScaled _size :: Rational
_size e :: Exp
e) = Exp -> Text
writeExp Exp
e
writeExp (EText ttype :: TextType
ttype s :: Text
s) =
let quoted :: Text
quoted = "\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\""
in case TextType
ttype of
TextNormal -> "roman " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
quoted
TextItalic -> Text
quoted
TextBold -> "bold " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
quoted
TextBoldItalic -> "bold italic " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
quoted
_ -> Text
quoted
writeExp (EStyled ttype :: TextType
ttype es :: [Exp]
es) =
let contents :: Text
contents = "{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Exp] -> Text
writeExps [Exp]
es Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "}"
in case TextType
ttype of
TextNormal -> "roman " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents
TextItalic -> "italic " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents
TextBold -> "bold " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents
TextBoldItalic -> "bold italic " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents
_ -> Text
contents
writeExp (EArray aligns :: [Alignment]
aligns rows :: [ArrayLine]
rows) =
"matrix{\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat [Text]
cols Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "}"
where cols :: [Text]
cols = (Alignment -> ArrayLine -> Text)
-> [Alignment] -> [ArrayLine] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Alignment -> ArrayLine -> Text
tocol [Alignment]
aligns ([ArrayLine] -> [ArrayLine]
forall a. [[a]] -> [[a]]
transpose [ArrayLine]
rows)
tocol :: Alignment -> ArrayLine -> Text
tocol al :: Alignment
al cs :: ArrayLine
cs =
(case Alignment
al of
AlignLeft -> "lcol"
AlignCenter -> "ccol"
AlignRight -> "rcol") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
"{ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate " above " (([Exp] -> Text) -> ArrayLine -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Exp] -> Text
tocell ArrayLine
cs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " }\n"
tocell :: [Exp] -> Text
tocell [e :: Exp
e] = Exp -> Text
writeExp' Exp
e
tocell es :: [Exp]
es = Exp -> Text
writeExp ([Exp] -> Exp
EGrouped [Exp]
es)
tshow :: Show a => a -> T.Text
tshow :: 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