{-# 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.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.Text (Text)

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

-- | Transforms an expression tree to equivalent Eqn with the default
-- packages (amsmath and amssymb)
writeEqn :: DisplayType -> [Exp] -> T.Text
writeEqn :: DisplayType -> [Exp] -> Text
writeEqn DisplayType
dt [Exp]
exprs =
  [Text] -> Text
T.unwords forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Exp -> Text
writeExp forall a b. (a -> b) -> a -> b
$ (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere (forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT forall a b. (a -> b) -> a -> b
$ DisplayType -> Exp -> Exp
S.handleDownup DisplayType
dt) [Exp]
exprs

-- like writeExp but inserts {} if contents contain a space
writeExp' :: Exp -> T.Text
writeExp' :: Exp -> Text
writeExp' e :: Exp
e@(EGrouped [Exp]
_) = Exp -> Text
writeExp Exp
e
writeExp' Exp
e = if (Char -> Bool) -> Text -> Bool
T.any (forall a. Eq a => a -> a -> Bool
== Char
' ') Text
s
                 then Text -> Text
asgroup Text
s
                 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
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Exp -> Text
writeExp

asgroup :: Text -> Text
asgroup :: Text -> Text
asgroup Text
"" = Text
"{\"\"}"  -- see #198
asgroup Text
t = Text
"{" forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
"}"

writeExp :: Exp -> T.Text
writeExp :: Exp -> Text
writeExp (ENumber Text
s) = Text
s
writeExp (EGrouped [Exp]
es) = Text -> Text
asgroup forall a b. (a -> b) -> a -> b
$ [Exp] -> Text
writeExps [Exp]
es
writeExp (EDelimited Text
open Text
close [InEDelimited]
es) =
  Text
"left " forall a. Semigroup a => a -> a -> a
<> forall {a}. (Eq a, IsString a) => a -> a
mbQuote Text
open forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
" " (forall a b. (a -> b) -> [a] -> [b]
map InEDelimited -> Text
fromDelimited [InEDelimited]
es) forall a. Semigroup a => a -> a -> a
<>
  Text
" right " forall a. Semigroup a => a -> a -> a
<> forall {a}. (Eq a, IsString a) => a -> a
mbQuote Text
close
  where fromDelimited :: InEDelimited -> Text
fromDelimited (Left Text
e)  = Text
"\"" forall a. Semigroup a => a -> a -> a
<> Text
e forall a. Semigroup a => a -> a -> a
<> Text
"\""
        fromDelimited (Right Exp
e) = Exp -> Text
writeExp Exp
e
        mbQuote :: a -> a
mbQuote a
"" = a
"\"\""
        mbQuote a
s  = a
s
writeExp (EMathOperator Text
s) =
  if Text
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"sin", Text
"cos", Text
"tan", Text
"sinh", Text
"cosh",
               Text
"tanh", Text
"arc", Text
"max", Text
"min", Text
"lim",
               Text
"log", Text
"ln", Text
"exp"]
     then Text
s
     else Text
"\"" forall a. Semigroup a => a -> a -> a
<> Text
s forall a. Semigroup a => a -> a -> a
<> Text
"\""
writeExp (ESymbol TeXSymbolType
Ord (Text -> String
T.unpack -> [Char
c]))  -- do not render "invisible operators"
  | Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'\x2061'..Char
'\x2064'] = Text
"" -- see 3.2.5.5 of mathml spec
writeExp (EIdentifier Text
s) = Exp -> Text
writeExp (TeXSymbolType -> Text -> Exp
ESymbol TeXSymbolType
Ord Text
s)
writeExp (ESymbol TeXSymbolType
t Text
s) =
  case Text
s of
    Text
"{"     -> Text
"\\[lC]"
    Text
"}"     -> Text
"\\[rC]"
    Text
"\8722" -> Text
"-"  -- minus sign, see #200
    Text
"\8943" -> Text
"cdots" -- centered ellipses, see #200
    Text
"\8805" -> Text
">="
    Text
"\8804" -> Text
"<="
    Text
"\8801" -> Text
"=="
    Text
"\8800" -> Text
"!="
    Text
"\177"  -> Text
"+-"
    Text
"\8594" -> Text
"->"
    Text
"\8592" -> Text
"<-"
    Text
"\8810" -> Text
"<<"
    Text
"\8811" -> Text
">>"
    Text
"\8734" -> Text
"inf"
    Text
"\8706" -> Text
"partial"
    Text
"\189"  -> Text
"half"
    Text
"\8242" -> Text
"prime"
    Text
"\8776" -> Text
"approx"
    Text
"\183"  -> Text
"cdot"
    Text
"\215"  -> Text
"times"
    Text
"\8711" -> Text
"grad"
    Text
"\8230" -> Text
"..."
    Text
"\8721" -> Text
"sum"
    Text
"\8747" -> Text
"int"
    Text
"\8719" -> Text
"prod"
    Text
"\8898" -> Text
"union"
    Text
"\8899" -> Text
"inter"
    Text
"\945" -> Text
"alpha"
    Text
"\946" -> Text
"beta"
    Text
"\967" -> Text
"chi"
    Text
"\948" -> Text
"delta"
    Text
"\916" -> Text
"DELTA"
    Text
"\1013" -> Text
"epsilon"
    Text
"\951" -> Text
"eta"
    Text
"\947" -> Text
"gamma"
    Text
"\915" -> Text
"GAMMA"
    Text
"\953" -> Text
"iota"
    Text
"\954" -> Text
"kappa"
    Text
"\955" -> Text
"lambda"
    Text
"\923" -> Text
"LAMBDA"
    Text
"\956" -> Text
"mu"
    Text
"\957" -> Text
"nu"
    Text
"\969" -> Text
"omega"
    Text
"\937" -> Text
"OMEGA"
    Text
"\981" -> Text
"phi"
    Text
"\966" -> Text
"varphi"
    Text
"\934" -> Text
"PHI"
    Text
"\960" -> Text
"pi"
    Text
"\928" -> Text
"PI"
    Text
"\968" -> Text
"psi"
    Text
"\936" -> Text
"PSI"
    Text
"\961" -> Text
"rho"
    Text
"\963" -> Text
"sigma"
    Text
"\931" -> Text
"SIGMA"
    Text
"\964" -> Text
"tau"
    Text
"\952" -> Text
"theta"
    Text
"\920" -> Text
"THETA"
    Text
"\965" -> Text
"upsilon"
    Text
"\933" -> Text
"UPSILON"
    Text
"\958" -> Text
"xi"
    Text
"\926" -> Text
"XI"
    Text
"\950" -> Text
"zeta"
    Text
_      -> let s' :: Text
s' = if (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isAscii Text
s
                          then Text
s
                          else Text
"\\[" forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords (forall a b. (a -> b) -> [a] -> [b]
map Char -> Text
toUchar forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s) forall a. Semigroup a => a -> a -> a
<> Text
"]"
                  toUchar :: Char -> Text
toUchar Char
c = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"u%04X" (Char -> Int
ord Char
c)
              in  if Text -> Int
T.length Text
s forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& (TeXSymbolType
t forall a. Eq a => a -> a -> Bool
== TeXSymbolType
Rel Bool -> Bool -> Bool
|| TeXSymbolType
t forall a. Eq a => a -> a -> Bool
== TeXSymbolType
Bin Bool -> Bool -> Bool
|| TeXSymbolType
t forall a. Eq a => a -> a -> Bool
== TeXSymbolType
Op)
                     then Text
"roman{\"" forall a. Semigroup a => a -> a -> a
<>
                          (if TeXSymbolType
t forall a. Eq a => a -> a -> Bool
== TeXSymbolType
Rel Bool -> Bool -> Bool
|| TeXSymbolType
t forall a. Eq a => a -> a -> Bool
== TeXSymbolType
Bin
                              then Text
" "
                              else Text
"") forall a. Semigroup a => a -> a -> a
<>
                          Text
s' forall a. Semigroup a => a -> a -> a
<>
                          (if TeXSymbolType
t forall a. Eq a => a -> a -> Bool
== TeXSymbolType
Rel Bool -> Bool -> Bool
|| TeXSymbolType
t forall a. Eq a => a -> a -> Bool
== TeXSymbolType
Bin Bool -> Bool -> Bool
|| TeXSymbolType
t forall a. Eq a => a -> a -> Bool
== TeXSymbolType
Op
                              then Text
" "
                              else Text
"") forall a. Semigroup a => a -> a -> a
<>
                          Text
"\"}"
                     else Text
s'

writeExp (ESpace Rational
d) =
  case Rational
d of
      Rational
_ | Rational
d forall a. Ord a => a -> a -> Bool
> Rational
0 Bool -> Bool -> Bool
&& Rational
d forall a. Ord a => a -> a -> Bool
< (Integer
2 forall a. Integral a => a -> a -> Ratio a
% Integer
9) -> Text
"^"
        | Rational
d forall a. Ord a => a -> a -> Bool
>= (Integer
2 forall a. Integral a => a -> a -> Ratio a
% Integer
9) Bool -> Bool -> Bool
&& Rational
d forall a. Ord a => a -> a -> Bool
< (Integer
3 forall a. Integral a => a -> a -> Ratio a
% Integer
9) -> Text
"~"
        | Rational
d forall a. Ord a => a -> a -> Bool
< Rational
0     -> Text
"back " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow (forall a b. (RealFrac a, Integral b) => a -> b
floor (-Rational
1 forall a. Num a => a -> a -> a
* Rational
d forall a. Num a => a -> a -> a
* Rational
100) :: Int)
        | Bool
otherwise -> Text
"fwd " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow (forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational
d forall a. Num a => a -> a -> a
* Rational
100) :: Int)
writeExp (EFraction FractionType
fractype Exp
e1 Exp
e2) = Exp -> Text
writeExp' Exp
e1 forall a. Semigroup a => a -> a -> a
<> Text
op forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp' Exp
e2
  where op :: Text
op = if FractionType
fractype forall a. Eq a => a -> a -> Bool
== FractionType
NoLineFrac
                then Text
" / "
                else Text
" over "
writeExp (ESub Exp
b Exp
e1) = Exp -> Text
writeExp' Exp
b forall a. Semigroup a => a -> a -> a
<> Text
" sub " forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp' Exp
e1
writeExp (ESuper Exp
b Exp
e1) = Exp -> Text
writeExp' Exp
b forall a. Semigroup a => a -> a -> a
<> Text
" sup " forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp' Exp
e1
writeExp (ESubsup Exp
b Exp
e1 Exp
e2) =
  Exp -> Text
writeExp' Exp
b forall a. Semigroup a => a -> a -> a
<> Text
" sub " forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp' Exp
e1 forall a. Semigroup a => a -> a -> a
<> Text
" sup " forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp' Exp
e2
writeExp (EOver Bool
_convertible Exp
b Exp
e1) =
  Exp -> Text
writeExp' Exp
b forall a. Semigroup a => a -> a -> a
<> Text
" to " forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp' Exp
e1
writeExp (EUnder Bool
_convertible Exp
b Exp
e1) =
  Exp -> Text
writeExp' Exp
b forall a. Semigroup a => a -> a -> a
<> Text
" from " forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp' Exp
e1
writeExp (EUnderover Bool
convertible Exp
b e1 :: Exp
e1@(ESymbol TeXSymbolType
Accent Text
_) 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 Bool
convertible Exp
b Exp
e1 e2 :: Exp
e2@(ESymbol TeXSymbolType
Accent Text
_)) =
  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 Bool
_convertible Exp
b Exp
e1 Exp
e2) =
  Exp -> Text
writeExp' Exp
b forall a. Semigroup a => a -> a -> a
<> Text
" from " forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp' Exp
e1 forall a. Semigroup a => a -> a -> a
<> Text
" to " forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp' Exp
e2
writeExp (ESqrt Exp
e) = Text
"sqrt " forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp' Exp
e
writeExp (ERoot Exp
i Exp
e) = Text
"\"\" sup " forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp' Exp
i forall a. Semigroup a => a -> a -> a
<> Text
" sqrt " forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp' Exp
e
writeExp (EPhantom Exp
e) = Text
"hphantom " forall a. Semigroup a => a -> a -> a
<> Exp -> Text
writeExp' Exp
e
writeExp (EBoxed Exp
e) = Exp -> Text
writeExp Exp
e -- TODO: any way to do this?
writeExp (EScaled Rational
_size Exp
e) = Exp -> Text
writeExp Exp
e -- TODO: any way?
writeExp (EText TextType
ttype Text
s) =
  let quoted :: Text
quoted = Text
"\"" forall a. Semigroup a => a -> a -> a
<> Text
s forall a. Semigroup a => a -> a -> a
<> Text
"\""
  in case TextType
ttype of
       TextType
TextNormal -> Text
"roman " forall a. Semigroup a => a -> a -> a
<> Text
quoted
       TextType
TextItalic -> Text
quoted
       TextType
TextBold   -> Text
"bold " forall a. Semigroup a => a -> a -> a
<> Text
quoted
       TextType
TextBoldItalic -> Text
"bold italic " forall a. Semigroup a => a -> a -> a
<> Text
quoted
       TextType
_   -> Text
quoted
writeExp (EStyled TextType
ttype [Exp]
es) =
  let contents :: Text
contents = Text -> Text
asgroup forall a b. (a -> b) -> a -> b
$ [Exp] -> Text
writeExps [Exp]
es
  in case TextType
ttype of
       TextType
TextNormal -> Text
"roman " forall a. Semigroup a => a -> a -> a
<> Text
contents
       TextType
TextItalic -> Text
"italic " forall a. Semigroup a => a -> a -> a
<> Text
contents
       TextType
TextBold   -> Text
"bold " forall a. Semigroup a => a -> a -> a
<> Text
contents
       TextType
TextBoldItalic -> Text
"bold italic " forall a. Semigroup a => a -> a -> a
<> Text
contents
       TextType
_   -> Text
contents
writeExp (EArray [Alignment]
aligns [ArrayLine]
rows) =
  Text
"matrix{\n" forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat [Text]
cols forall a. Semigroup a => a -> a -> a
<> Text
"}"
  where cols :: [Text]
cols = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Alignment -> ArrayLine -> Text
tocol [Alignment]
aligns (forall a. [[a]] -> [[a]]
transpose [ArrayLine]
rows)
        tocol :: Alignment -> ArrayLine -> Text
tocol Alignment
al ArrayLine
cs =
          (case Alignment
al of
               Alignment
AlignLeft -> Text
"lcol"
               Alignment
AlignCenter -> Text
"ccol"
               Alignment
AlignRight -> Text
"rcol") forall a. Semigroup a => a -> a -> a
<>
            Text
"{ " forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
" above " (forall a b. (a -> b) -> [a] -> [b]
map [Exp] -> Text
tocell ArrayLine
cs) forall a. Semigroup a => a -> a -> a
<> Text
" }\n"
        tocell :: [Exp] -> Text
tocell [Exp
e] = Exp -> Text
writeExp' Exp
e
        tocell [Exp]
es  = Exp -> Text
writeExp ([Exp] -> Exp
EGrouped [Exp]
es)

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