{-# LANGUAGE GeneralizedNewtypeDeriving, ViewPatterns, GADTs, OverloadedStrings #-}
module Text.TeXMath.Writers.Typst (writeTypst) where
import Data.List (transpose)
import qualified Data.Map as M
import qualified Data.Text as T
import Text.TeXMath.Types
import qualified Text.TeXMath.Shared as S
import Typst.Symbols (typstSymbols)
import Data.Generics (everywhere, mkT)
import Data.Text (Text)
import Data.Char (isDigit, isAlpha, isAscii)
import Data.Maybe (fromMaybe)
writeTypst :: DisplayType -> [Exp] -> Text
writeTypst :: DisplayType -> [Exp] -> Text
writeTypst DisplayType
dt [Exp]
exprs =
[Exp] -> Text
writeExps ([Exp] -> Text) -> [Exp] -> Text
forall a b. (a -> b) -> a -> b
$ (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
writeExps :: [Exp] -> Text
writeExps :: [Exp] -> Text
writeExps = [Text] -> Text
go ([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
where
go :: [Text] -> Text
go (Text
a : Text
b : [Text]
es)
| Int -> Text -> Text
T.take Int
1 Text
b Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"'"
= Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
go (Text
bText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
es)
go (Text
a : [Text]
as)
= Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
as
then Text
forall a. Monoid a => a
mempty
else Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
go [Text]
as
go [] = Text
forall a. Monoid a => a
mempty
inParens :: Text -> Text
inParens :: Text -> Text
inParens Text
s = Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
inQuotes :: Text -> Text
inQuotes :: Text -> Text
inQuotes Text
s = Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escInQuotes Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
esc :: Text -> Text
esc :: Text -> Text
esc Text
t =
if (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
needsEscape Text
t
then (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escapeChar Text
t
else Text
t
where
escapeChar :: Char -> Text
escapeChar Char
c
| Char -> Bool
needsEscape Char
c = Text
"\\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
c
| Bool
otherwise = Char -> Text
T.singleton Char
c
needsEscape :: Char -> Bool
needsEscape Char
'[' = Bool
True
needsEscape Char
']' = Bool
True
needsEscape Char
'|' = Bool
True
needsEscape Char
'#' = Bool
True
needsEscape Char
'$' = Bool
True
needsEscape Char
'(' = Bool
True
needsEscape Char
')' = Bool
True
needsEscape Char
'_' = Bool
True
needsEscape Char
'*' = Bool
True
needsEscape Char
'^' = Bool
True
needsEscape Char
'"' = Bool
True
needsEscape Char
'/' = Bool
True
needsEscape Char
'\\' = Bool
True
needsEscape Char
',' = Bool
True
needsEscape Char
_ = Bool
False
escInQuotes :: Text -> Text
escInQuotes :: Text -> Text
escInQuotes Text
t =
if (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
needsEscape Text
t
then (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escapeChar Text
t
else Text
t
where
escapeChar :: Char -> Text
escapeChar Char
c
| Char -> Bool
needsEscape Char
c = Text
"\\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
c
| Bool
otherwise = Char -> Text
T.singleton Char
c
needsEscape :: Char -> Bool
needsEscape Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"'
writeExpS :: Exp -> Text
writeExpS :: Exp -> Text
writeExpS Exp
e =
case Exp -> Text
writeExp Exp
e of
Text
"" -> Text
"()"
Text
t | Just (Char
c,Text
_) <- Text -> Maybe (Char, Text)
T.uncons Text
t
, Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\8988' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\8991'
-> Text
"\\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
Text
t | (Char -> Bool) -> Text -> Bool
T.all (\Char
c -> Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') Text
t -> Text
t
| (Char -> Bool) -> Text -> Bool
T.all (\Char
c -> Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') Text
t -> Text
t
| Bool
otherwise -> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
writeExpB :: Exp -> Text
writeExpB :: Exp -> Text
writeExpB Exp
e =
case Exp -> Text
writeExp Exp
e of
Text
"" -> Text
"zws"
Text
t -> Text
t
writeExp :: Exp -> Text
writeExp :: Exp -> Text
writeExp (ENumber Text
s) = Text
s
writeExp (ESymbol TeXSymbolType
_t Text
s)
| (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAscii Text
s = Text -> Text
esc Text
s
| Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"\x2212" = Text
"-"
| Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"\8242" = Text
"'"
| Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"\8243" = Text
"''"
| Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"\8244" = Text
"'''"
| Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"\8279" = Text
"''''"
| Bool
otherwise = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (Text -> Text
esc Text
s) (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
s Map Text Text
typstSymbolMap
writeExp (EIdentifier Text
s) =
if Text -> Int
T.length Text
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
then Exp -> Text
writeExp (TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Ord Text
s)
else Text -> Text
inQuotes Text
s
writeExp (EMathOperator Text
s)
| Text
s Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"arccos", Text
"arcsin", Text
"arctan", Text
"arg", Text
"cos", Text
"cosh",
Text
"cot", Text
"ctg", Text
"coth", Text
"csc", Text
"deg", Text
"det", Text
"dim", Text
"exp",
Text
"gcd", Text
"hom", Text
"mod", Text
"inf", Text
"ker", Text
"lg", Text
"lim", Text
"ln",
Text
"log", Text
"max", Text
"min", Text
"Pr", Text
"sec", Text
"sin", Text
"sinh", Text
"sup",
Text
"tan", Text
"tg", Text
"tanh", Text
"liminf", Text
"and", Text
"limsup"]
= Text
s
| Bool
otherwise = Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
writeExp (EGrouped [Exp]
es) = [Exp] -> Text
writeExps [Exp]
es
writeExp (EFraction FractionType
_fractype Exp
e1 Exp
e2) =
case (Exp
e1, Exp
e2) of
(EGrouped [Exp]
_, Exp
_) -> Text
"frac(" 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
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp Exp
e2 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
(Exp
_, EGrouped [Exp]
_) -> Text
"frac(" 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
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp Exp
e2 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
(Exp, Exp)
_ -> Exp -> Text
writeExp Exp
e1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" / " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp Exp
e2
writeExp (ESub Exp
b Exp
e1) = Exp -> Text
writeExpB Exp
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExpS Exp
e1
writeExp (ESuper Exp
b Exp
e1) = Exp -> Text
writeExpB Exp
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"^" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExpS Exp
e1
writeExp (ESubsup Exp
b Exp
e1 Exp
e2) = Exp -> Text
writeExpB Exp
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExpS Exp
e1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"^" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExpS Exp
e2
writeExp (EOver Bool
_ (EOver Bool
_ Exp
b (ESymbol TeXSymbolType
TOver Text
"\9182")) Exp
e1) =
Text
"overbrace(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp Exp
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " 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
<> Text
")"
writeExp (EOver Bool
_ (EOver Bool
_ Exp
b (ESymbol TeXSymbolType
TOver Text
"\9140")) Exp
e1) =
Text
"overbracket(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp Exp
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " 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
<> Text
")"
writeExp (EOver Bool
_convertible Exp
b (ESymbol TeXSymbolType
Accent Text
ac))
= case Text -> Maybe Text
getAccentCommand Text
ac of
Just Text
accCommand
| Bool -> Bool
not (Exp -> Bool
isGrouped Exp
b) -> Text
accCommand Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Exp -> Text
writeExp Exp
b)
Maybe Text
_ -> Text
"accent" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Exp -> Text
writeExp Exp
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ac)
writeExp (EOver Bool
_convertible Exp
b Exp
e1) =
case Exp
e1 of
ESymbol TeXSymbolType
TOver Text
"\9182" -> Text
"overbrace" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Exp -> Text
writeExp Exp
b)
ESymbol TeXSymbolType
TOver Text
"\9140" -> Text
"overbracket" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Exp -> Text
writeExp Exp
b)
ESymbol TeXSymbolType
TOver Text
"\175" -> Text
"overline" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Exp -> Text
writeExp Exp
b)
Exp
_ -> Exp -> Text
writeExpB Exp
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"^" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExpS Exp
e1
writeExp (EUnder Bool
_ (EUnder Bool
_ Exp
b (ESymbol TeXSymbolType
TUnder Text
"\9183")) Exp
e1) =
Text
"underbrace(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp Exp
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " 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
<> Text
")"
writeExp (EUnder Bool
_ (EUnder Bool
_ Exp
b (ESymbol TeXSymbolType
TUnder Text
"\9140")) Exp
e1) =
Text
"underbrace(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp Exp
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " 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
<> Text
")"
writeExp (EUnder Bool
_convertible Exp
b Exp
e1) =
case Exp
e1 of
ESymbol TeXSymbolType
TUnder Text
"_" -> Text
"underline(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp Exp
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
ESymbol TeXSymbolType
TUnder Text
"\817" -> Text
"underline(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp Exp
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
ESymbol TeXSymbolType
TUnder Text
"\9183" -> Text
"underbrace(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp Exp
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
ESymbol TeXSymbolType
TUnder Text
"\9140" -> Text
"underbracket(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp Exp
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
Exp
_ -> Exp -> Text
writeExpB Exp
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExpS Exp
e1
writeExp (EUnderover Bool
convertible Exp
b Exp
e1 Exp
e2) =
case (Exp
e1, Exp
e2) of
(Exp
_, ESymbol TeXSymbolType
Accent Text
_) -> Exp -> Text
writeExp (Bool -> Exp -> Exp -> Exp
EUnder Bool
convertible (Bool -> Exp -> Exp -> Exp
EOver Bool
False Exp
b Exp
e2) Exp
e1)
(Exp
_, ESymbol TeXSymbolType
TOver Text
_) -> Exp -> Text
writeExp (Bool -> Exp -> Exp -> Exp
EUnder Bool
convertible (Bool -> Exp -> Exp -> Exp
EOver Bool
False Exp
b Exp
e2) Exp
e1)
(ESymbol TeXSymbolType
TUnder Text
_, Exp
_) -> Exp -> Text
writeExp (Bool -> Exp -> Exp -> Exp
EOver Bool
convertible (Bool -> Exp -> Exp -> Exp
EUnder Bool
False Exp
b Exp
e1) Exp
e2)
(Exp, Exp)
_ -> Exp -> Text
writeExpB Exp
b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExpS Exp
e1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"^" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExpS Exp
e2
writeExp (ESqrt Exp
e) = Text
"sqrt(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp Exp
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
writeExp (ERoot Exp
i Exp
e) = Text
"root(" 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
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp Exp
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
writeExp (ESpace 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
Int
0 -> Text
"zws"
Int
3 -> Text
"thin"
Int
4 -> Text
"med"
Int
6 -> Text
"thick"
Int
18 -> Text
"quad"
Int
n -> Text
"#h(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
18) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"em)"
writeExp (EText TextType
ttype Text
s) =
case TextType
ttype of
TextType
TextNormal -> Text
"upright" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Text -> Text
inQuotes Text
s)
TextType
TextItalic -> Text
"italic" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Text -> Text
inQuotes Text
s)
TextType
TextBold -> Text
"bold" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Text -> Text
inQuotes Text
s)
TextType
TextBoldItalic -> Text
"bold" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Text
"italic" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Text -> Text
inQuotes Text
s))
TextType
TextMonospace -> Text
"mono" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Text -> Text
inQuotes Text
s)
TextType
TextSansSerif -> Text
"sans" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Text -> Text
inQuotes Text
s)
TextType
TextDoubleStruck -> Text
"bb" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Text -> Text
inQuotes Text
s)
TextType
TextScript -> Text
"cal" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Text -> Text
inQuotes Text
s)
TextType
TextFraktur -> Text
"frak" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Text -> Text
inQuotes Text
s)
TextType
TextSansSerifBold -> Text
"bold" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Text
"sans" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Text -> Text
inQuotes Text
s))
TextType
TextSansSerifBoldItalic -> Text
"bold" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text -> Text
inParens (Text
"italic" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Text
"sans" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Text -> Text
inQuotes Text
s)))
TextType
TextBoldScript -> Text
"bold" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Text
"cal" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Text -> Text
inQuotes Text
s))
TextType
TextBoldFraktur -> Text
"bold" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Text
"frak" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Text -> Text
inQuotes Text
s))
TextType
TextSansSerifItalic -> Text
"italic" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text -> Text
inParens (Text
"sans" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Text -> Text
inQuotes Text
s))
writeExp (EStyled TextType
ttype [Exp]
es) =
let contents :: Text
contents = [Exp] -> Text
writeExps [Exp]
es
in case TextType
ttype of
TextType
TextNormal -> Text
"upright" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens Text
contents
TextType
TextItalic -> Text
"italic" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens Text
contents
TextType
TextBold -> Text
"bold" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens Text
contents
TextType
TextBoldItalic -> Text
"bold" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Text
"italic" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens Text
contents)
TextType
TextMonospace -> Text
"mono" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens Text
contents
TextType
TextSansSerif -> Text
"sans" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens Text
contents
TextType
TextDoubleStruck -> Text
"bb" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens Text
contents
TextType
TextScript -> Text
"cal" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens Text
contents
TextType
TextFraktur -> Text
"frak" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens Text
contents
TextType
TextSansSerifBold -> Text
"bold" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Text
"sans" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens Text
contents)
TextType
TextSansSerifBoldItalic -> Text
"bold" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text -> Text
inParens (Text
"italic" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Text
"sans" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens Text
contents))
TextType
TextBoldScript -> Text
"bold" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Text
"cal" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens Text
contents)
TextType
TextBoldFraktur -> Text
"bold" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Text
"frak" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens Text
contents)
TextType
TextSansSerifItalic -> Text
"italic" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens (Text
"sans" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens Text
contents)
writeExp (EBoxed Exp
e) = Text
"#box(stroke: black, inset: 3pt, [$ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp Exp
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" $])"
writeExp (EPhantom Exp
e) = Text
"#hide[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp Exp
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
writeExp (EScaled Rational
size Exp
e) =
Text
"#scale(x: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (Rational -> Int
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational
100 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
size) :: Int) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"%, y: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (Rational -> Int
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational
100 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
size) :: Int) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"%)[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp Exp
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
writeExp (EDelimited Text
"(" Text
")" [ Right (EFraction FractionType
NoLineFrac Exp
x Exp
y) ]) =
Text
"binom(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp Exp
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp Exp
y Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
writeExp (EDelimited Text
"(" Text
")" [Right (EArray [Alignment]
_aligns [ArrayLine]
rows)])
| (ArrayLine -> Bool) -> [ArrayLine] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\ArrayLine
row -> ArrayLine -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ArrayLine
row Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) [ArrayLine]
rows =
Text
"vec(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [ArrayLine] -> Text
mkArray ([ArrayLine] -> [ArrayLine]
forall a. [[a]] -> [[a]]
transpose [ArrayLine]
rows) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
writeExp (EDelimited Text
"(" Text
")" [Right (EArray [Alignment]
_aligns [[[Exp]
xs],[[Exp]
ys]])]) =
Text
"binom(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Exp] -> Text
writeExps [Exp]
xs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Exp] -> Text
writeExps [Exp]
ys Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
writeExp (EDelimited Text
"(" Text
")" [Right (EArray [Alignment]
_aligns [ArrayLine]
rows)]) =
Text
"mat(delim: \"(\", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [ArrayLine] -> Text
mkArray [ArrayLine]
rows Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
writeExp (EDelimited Text
"[" Text
"]" [Right (EArray [Alignment]
_aligns [ArrayLine]
rows)]) =
Text
"mat(delim: \"[\", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [ArrayLine] -> Text
mkArray [ArrayLine]
rows Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
writeExp (EDelimited Text
"{" Text
"}" [Right (EArray [Alignment]
_aligns [ArrayLine]
rows)]) =
Text
"mat(delim: \"{\", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [ArrayLine] -> Text
mkArray [ArrayLine]
rows Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
writeExp (EDelimited Text
"|" Text
"|" [Right (EArray [Alignment]
_aligns [ArrayLine]
rows)]) =
Text
"mat(delim: \"|\", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [ArrayLine] -> Text
mkArray [ArrayLine]
rows Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
writeExp (EDelimited Text
"||" Text
"||" [Right (EArray [Alignment]
_aligns [ArrayLine]
rows)]) =
Text
"mat(delim: \"||\", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [ArrayLine] -> Text
mkArray [ArrayLine]
rows Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
writeExp (EDelimited Text
"\x2223" Text
"\x2223" [Right (EArray [Alignment]
_aligns [ArrayLine]
rows)]) =
Text
"mat(delim: \"||\", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [ArrayLine] -> Text
mkArray [ArrayLine]
rows Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
writeExp (EDelimited Text
"\x2225" Text
"\x2225" [Right (EArray [Alignment]
_aligns [ArrayLine]
rows)]) =
Text
"mat(delim: \"||\", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [ArrayLine] -> Text
mkArray [ArrayLine]
rows Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
writeExp (EDelimited Text
op Text
"" [Right (EArray [Alignment
AlignLeft, Alignment
AlignLeft] [ArrayLine]
rows)]) =
Text
"cases" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inParens(Text
"delim: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
inQuotes Text
op Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ((ArrayLine -> Text) -> [ArrayLine] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ArrayLine -> Text
toCase [ArrayLine]
rows))
where toCase :: ArrayLine -> Text
toCase = (Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (ArrayLine -> Text) -> ArrayLine -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
" & " ([Text] -> Text) -> (ArrayLine -> [Text]) -> ArrayLine -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Exp] -> Text) -> ArrayLine -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Exp] -> Text
writeExps
writeExp (EDelimited Text
open Text
close [Either Text Exp]
es) =
if Text -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
isDelim Text
open Bool -> Bool -> Bool
&& Text -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
isDelim Text
close
then
(if Text -> Text -> Bool
forall {a} {a}.
(Eq a, Eq a, IsString a, IsString a) =>
a -> a -> Bool
matchedPair Text
open Text
close Bool -> Bool -> Bool
&&
Bool -> Bool
not ((Either Text Exp -> Bool) -> [Either Text Exp] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Either Text Exp
x -> Either Text Exp
x Either Text Exp -> Either Text Exp -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Either Text Exp
forall a b. a -> Either a b
Left Text
open Bool -> Bool -> Bool
|| Either Text Exp
x Either Text Exp -> Either Text Exp -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Either Text Exp
forall a b. a -> Either a b
Left Text
close) [Either Text Exp]
es)
then Text -> Text
forall a. a -> a
id
else (Text
"lr" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
inParens)
(Text -> Text
renderOpen Text
open Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
body Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
renderClose Text
close)
else Text -> Text
esc Text
open Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
body Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
esc Text
close
where fromDelimited :: Either Text Exp -> Text
fromDelimited (Left Text
e) = Text
"mid(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
renderSymbol Text
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
fromDelimited (Right Exp
e) = Exp -> Text
writeExp Exp
e
isDelim :: a -> Bool
isDelim a
c = a
c a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a
"(",a
")",a
"[",a
"]",a
"{",a
"}",a
"|",a
"||",a
"\x2016"]
renderOpen :: Text -> Text
renderOpen Text
e =
if (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAscii Text
e
then Text
e
else Text -> Text
renderSymbol Text
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
renderClose :: Text -> Text
renderClose Text
e =
if (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAscii Text
e
then Text
e
else Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
renderSymbol Text
e
renderSymbol :: Text -> Text
renderSymbol Text
e = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (Text -> Text
esc Text
e) (Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
e Map Text Text
typstSymbolMap)
matchedPair :: a -> a -> Bool
matchedPair a
"(" a
")" = Bool
True
matchedPair a
"[" a
"]" = Bool
True
matchedPair a
"{" a
"}" = Bool
True
matchedPair a
_ a
_ = Bool
False
body :: Text
body = [Text] -> Text
T.unwords ((Either Text Exp -> Text) -> [Either Text Exp] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Either Text Exp -> Text
fromDelimited [Either Text Exp]
es)
writeExp (EArray [Alignment]
_aligns [ArrayLine]
rows)
= Text -> [Text] -> Text
T.intercalate Text
"\\\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (ArrayLine -> Text) -> [ArrayLine] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ArrayLine -> Text
mkRow [ArrayLine]
rows
where mkRow :: ArrayLine -> Text
mkRow = Text -> [Text] -> Text
T.intercalate Text
" & " ([Text] -> Text) -> (ArrayLine -> [Text]) -> ArrayLine -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Exp] -> Text) -> ArrayLine -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Exp] -> Text
writeExps
mkArray :: [[[Exp]]] -> Text
mkArray :: [ArrayLine] -> Text
mkArray [ArrayLine]
rows =
Text -> [Text] -> Text
T.intercalate Text
"; " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (ArrayLine -> Text) -> [ArrayLine] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ArrayLine -> Text
mkRow [ArrayLine]
rows
where
mkRow :: ArrayLine -> Text
mkRow = Text -> [Text] -> Text
T.intercalate Text
", " ([Text] -> Text) -> (ArrayLine -> [Text]) -> ArrayLine -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall {a}. (Eq a, IsString a) => [a] -> [a]
mkCells ([Text] -> [Text]) -> (ArrayLine -> [Text]) -> ArrayLine -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Exp] -> Text) -> ArrayLine -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Exp] -> Text
mkCell
mkCells :: [a] -> [a]
mkCells [a]
cs =
case [a]
cs of
(a
"":[a]
rest) -> a
"#none" a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rest
[a]
_ -> [a]
cs
mkCell :: [Exp] -> Text
mkCell = [Exp] -> Text
writeExps
tshow :: Show a => a -> 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
typstSymbolMap :: M.Map Text Text
typstSymbolMap :: Map Text Text
typstSymbolMap = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, Text)] -> Map Text Text)
-> [(Text, Text)] -> Map Text Text
forall a b. (a -> b) -> a -> b
$
(Text
"\776", Text
"dot.double")
(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text
s,Text
name) | (Text
name, Bool
_, Text
s) <- [(Text, Bool, Text)]
typstSymbols]
getAccentCommand :: Text -> Maybe Text
getAccentCommand :: Text -> Maybe Text
getAccentCommand Text
ac = do
case Text
ac of
Text
"`" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"grave"
Text
"\180" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"acute"
Text
"^" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"hat"
Text
"~" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"tilde"
Text
"." -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"dot"
Text
"\168" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"diaer"
Text
"\175" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"macron"
Text
"\711" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"caron"
Text
"\728" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"breve"
Text
"\733" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"acute.double"
Text
"\768" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"grave"
Text
"\769" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"acute"
Text
"\770" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"hat"
Text
"\771" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"tilde"
Text
"\772" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"macron"
Text
"\773" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"overline"
Text
"\774" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"breve"
Text
"\775" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"dot"
Text
"\776" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"dot.double"
Text
"\777" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"harpoon"
Text
"\778" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"circle"
Text
"\779" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"acute.double"
Text
"\780" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"caron"
Text
"\781" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"overline"
Text
"\x2218" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"circle"
Text
"\x2192" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"->"
Text
"\x2190" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"<-"
Text
"\8254" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"macron"
Text
"\8400" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"harpoon.lt"
Text
"\8401" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"harpoon"
Text
"\8406" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"arrow.l"
Text
"\8407" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"arrow"
Text
"\8417" -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"arrow.l.r"
Text
_ -> Maybe Text
forall a. Maybe a
Nothing
isGrouped :: Exp -> Bool
isGrouped :: Exp -> Bool
isGrouped (EGrouped [Exp]
_) = Bool
True
isGrouped Exp
_ = Bool
False