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

-- 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 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

-- like writeExp but inserts {} if contents contain a space
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]))  -- do not render "invisible operators"
  | Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ['\x2061'..'\x2064'] = "" -- see 3.2.5.5 of mathml spec
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 -- TODO: any way to do this?
writeExp (EScaled _size :: Rational
_size e :: Exp
e) = Exp -> Text
writeExp Exp
e -- TODO: any way?
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