module Math.LaTeX.Internal.Display where
import qualified Text.LaTeX as LaTeX
import Text.LaTeX (raw)
import Text.LaTeX.Base.Class (LaTeXC, fromLaTeX)
import qualified Text.LaTeX.Base.Class as LaTeX
import qualified Text.LaTeX.Base.Types as LaTeX
import qualified Text.LaTeX.Base.Commands as LaTeX
import Text.LaTeX.Base.Syntax (LaTeX(TeXEnv))
import qualified Text.LaTeX.Packages.AMSMath as LaTeX
import qualified Text.LaTeX.Packages.AMSFonts as LaTeX
import CAS.Dumb
import CAS.Dumb.Tree
import CAS.Dumb.Symbols
import CAS.Dumb.LaTeX.Symbols
import Math.LaTeX.Internal.MathExpr
import Data.Foldable (fold)
import Data.Monoid ((<>))
import Control.Arrow
import Data.String (fromString)
infixl 1 >$
(>$) :: (LaTeXC r, SymbolClass σ, SCConstraint σ LaTeX)
=> r -> CAS (Infix LaTeX) (Encapsulation LaTeX) (SymbolD σ LaTeX) -> r
s >$ m = s <> " " <> LaTeX.math (toMathLaTeX' m)
dmaths :: (LaTeXC r, SymbolClass σ, SCConstraint σ LaTeX)
=> [[CAS (Infix LaTeX) (Encapsulation LaTeX) (SymbolD σ LaTeX)]]
-> String
-> r
dmaths [[e]] garnish = case eqnum of
Nothing -> fromLaTeX . TeXEnv "dmath*" [] $ toMathLaTeX e <> terminator
Just n -> fromLaTeX . TeXEnv "equation" [] $ n <> toMathLaTeX e <> terminator
where (eqnum, terminator) = parseEqnum garnish
dmaths eqLines garnish = fromLaTeX . TeXEnv
(case eqnum of{Nothing->"align*";Just _->"align"}) [] $ stack eqLines
where stack [singline] = fold eqnum <> aliLine singline <> terminator
stack (line : lines) = aliLine line <> LaTeX.lnbk <> stack lines
aliLine [] = mempty
aliLine [q] = contentsWithAlignAnchor q
aliLine (q : cols)
= contentsWithAlignAnchor q LaTeX.& aliLine cols
(eqnum, terminator) = parseEqnum garnish
maths :: (LaTeXC r, SymbolClass σ, SCConstraint σ LaTeX)
=> [[CAS (Infix LaTeX) (Encapsulation LaTeX) (SymbolD σ LaTeX)]]
-> String
-> r
maths [[e]] garnish = case eqnum of
Nothing -> fromLaTeX . TeXEnv "equation*" [] $ toMathLaTeX e <> terminator
Just n -> fromLaTeX . TeXEnv "equation" [] $ n <> toMathLaTeX e <> terminator
where (eqnum, terminator) = parseEqnum garnish
maths eqLines garnish = fromLaTeX . TeXEnv
(case eqnum of{Nothing->"align*";Just _->"align"}) [] $ stack eqLines
where stack [singline] = fold eqnum <> aliLine singline <> terminator
stack (line : lines) = aliLine line <> LaTeX.lnbk <> stack lines
aliLine [] = mempty
aliLine [q] = contentsWithAlignAnchor q
aliLine (q : cols)
= contentsWithAlignAnchor q LaTeX.& aliLine cols
(eqnum, terminator) = parseEqnum garnish
dcalculation :: (LaTeXC (m ()), SymbolClass σ, SCConstraint σ LaTeX, Functor m)
=> CAS (Infix LaTeX) (Encapsulation LaTeX) (SymbolD σ LaTeX)
-> String
-> m (CAS (Infix LaTeX) (Encapsulation LaTeX) (SymbolD σ LaTeX))
dcalculation ch garnish = fmap (\() -> result) $ case eqnum of
Nothing -> fromLaTeX . TeXEnv "dmath*" [] $ toMathLaTeX ch <> terminator
Just n -> fromLaTeX . TeXEnv "equation" [] $ n <> toMathLaTeX ch <> terminator
where (eqnum, terminator) = parseEqnum garnish
result = case ch of
OperatorChain _ ((_,r):_) -> r
r -> r
parseEqnum :: LaTeXC r => String -> (Maybe r, r)
parseEqnum [] = (Nothing, mempty)
parseEqnum ('.':n) = second ("."<>) $ parseEqnum n
parseEqnum (',':n) = second (","<>) $ parseEqnum n
parseEqnum ('!':n) = second ("!"<>) $ parseEqnum n
parseEqnum ('?':n) = second ("?"<>) $ parseEqnum n
parseEqnum (';':n) = second (";"<>) $ parseEqnum n
parseEqnum (':':n) = second (raw"{:}"<>) $ parseEqnum n
parseEqnum ('(':n) = ( Just $ raw"\\tag{"<>fromString num<>raw"}"
, snd $ parseEqnum r )
where (num,')':r) = break (==')') n
parseEqnum (c:n) = parseEqnum n
contentsWithAlignAnchor :: (LaTeXC c, SymbolClass σ, SCConstraint σ LaTeX)
=> CAS (Infix LaTeX) (Encapsulation LaTeX) (SymbolD σ LaTeX) -> c
contentsWithAlignAnchor (OperatorChain lc rcs@(_:_))
= toMathLaTeX' lc <> fromLaTeX op
<> raw"\\:"LaTeX.&toMathLaTeX' (OperatorChain rc₀ $ init rcs)
where (Infix _ op, rc₀) = last rcs
contentsWithAlignAnchor (Operator (Infix _ op) lc rc)
= toMathLaTeX' lc <> fromLaTeX op <> raw"\\:"LaTeX.&toMathLaTeX' rc
contentsWithAlignAnchor q = raw"\\:" LaTeX.& toMathLaTeX' q