{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE CPP #-}
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, TeXComm))
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)
import Data.Char (isAlpha)
infixl 1 >$
(>$) :: (LaTeXC r, LaTeXSymbol σ)
=> r -> LaTeXMath σ -> r
s >$ m = s <> " " <> LaTeX.math (toMathLaTeX' m)
infixr 6 $<>
($<>) :: (LaTeXC r, LaTeXSymbol σ)
=> LaTeXMath σ -> r -> r
m $<> s = LaTeX.math (toMathLaTeX' m) <> s
dmaths :: (LaTeXC r, LaTeXSymbol σ)
=> [[LaTeXMath σ]]
-> 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
equations :: (LaTeXC r, LaTeXSymbol σ)
=> [(LaTeXMath σ, String)]
-> String
-> r
equations [(e,lbl)] garnish = fromLaTeX $ case eqnum of
Nothing -> TeXEnv "equation" []
$ maybe mempty id eqnum <> toMathLaTeX e <> terminator <> asSafeLabel lbl
Just tag -> TeXEnv "equation*" []
$ tag <> toMathLaTeX e <> terminator <> asSafeLabel lbl
where (eqnum, terminator) = parseEqnum garnish
equations eqLines garnish = fromLaTeX . TeXEnv "align" [] $ stack eqLines
where stack [singline] = fold eqnum <> aliLine singline <> terminator
stack (line : lines) = aliLine line <> LaTeX.lnbk <> stack lines
aliLine (q, lbl) = contentsWithAlignAnchor q <> asSafeLabel lbl
terminator :: LaTeX
(eqnum, terminator) = parseEqnum garnish
asSafeLabel :: String -> LaTeX
asSafeLabel = LaTeX.label . fromString . filter isAlpha
maths :: (LaTeXC r, LaTeXSymbol σ)
=> [[LaTeXMath σ]]
-> 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 ()), LaTeXSymbol σ, Functor m)
=> LaTeXMath σ
-> String
-> m (LaTeXMath σ)
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, LaTeXSymbol σ)
=> LaTeXMath σ -> 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