{-# LANGUAGE CPP, OverloadedStrings, TypeFamilies #-}
#if __GLASGOW_HASKELL__ >= 801
{-# OPTIONS_GHC -Wno-orphans #-}
#else
{-# OPTIONS_GHC -fno-warn-orphans #-}
#endif

-- | <https://ctan.org/pkg/amsmath?lang=en amsmath> is a de-facto standard
--  package for maths in LaTeX. It is used in most scientific documents
--  and also available by default in MathJax.
-- 
-- Note that many of the maths commands this module exports are actually defined
--  in LaTeX itself, and do not really require the @amsmath@ package.
--  See the "Text.LaTeX.Base.Math" module for this minimal command-set.
module Text.LaTeX.Packages.AMSMath
 ( -- * AMSMath package
   amsmath
   -- * Math Environments
 , math, mathDisplay
 , equation , equation_
 , align , align_
 , cases
   -- ** Referencing
 , eqref , nonumber
   -- * Symbols and utilities
   
   -- ** Brackets / delimiters
 , autoParens
 , autoSquareBrackets, autoBraces, autoAngleBrackets
 , autoBrackets
 
 , langle , rangle
 , lfloor , rfloor
 , lceil , rceil 
 , dblPipe
   -- ** Superscript and subscript
 , (^:) , (!:), (!^)
   -- ** Function symbols
   -- | Some symbols are preceded with /t/ to be distinguished from
   --   predefined Haskell entities (like 'sin' and 'cos').
 , tsin , arcsin
 , tcos , arccos
 , ttan , arctan
 , cot , arccot
 , tsinh , tcosh , ttanh , coth
 , sec , csc
 , texp
 , tlog , ln
 , tsqrt
   -- ** Custom function symbols
 , operatorname
   -- ** Summation \/ integration \/ differentiation \/ relations
 , tsum , sumFromTo
 , prod , prodFromTo
 , coprod, coprodFromTo
 , integral , integralFromTo
 , partial, totald, partialOf, totaldOf
 , bigcup, bigcupFromTo
 , bigcap, bigcapFromTo 
   -- ** Operator symbols
   -- *** Arithmetic
 , (+-), (-+)
 , cdot , times , div_
 , frac, tfrac
 , (*:) , star
 , circ , bullet
   -- *** Comparison
 , (=:) , (/=:)
 , (<:) , (<=:)
 , (>:) , (>=:)
 , ll , gg
 , equiv
 , propto
 , parallel
 , perp
 , approx
 , sim
 , simeq
 , cong
   -- *** Sets
 , in_ , ni , notin
 , subset , supset
 , subseteq , supseteq
 , cap , cup
 , setminus
   -- *** Misc operators
 , vee , wedge
 , oplus , ominus , otimes
 , oslash , odot
   -- *** Accents
 , hat, tilde, bar, vec, widehat, widetilde
 , dot, ddot, dddot
 , overline
 
   -- ** Greek alphabet
   -- | Functions of greek alphabet symbols.
   --
   --   Uppercase versions are suffixed with @u@.
   --   Variants are prefixed with @var@.
   --   The function 'pi_' is ended by an underscore symbol to
   --   distinguish it from the 'pi' Prelude function.
 , alpha    , beta       , gamma
 , gammau   , delta      , deltau
 , epsilon  , varepsilon , zeta
 , eta      , theta      , vartheta , thetau
 , iota     , kappa      , lambda
 , lambdau  , mu         , nu
 , xi       , xiu        , pi_
 , varpi    , piu        , rho
 , varrho   , sigma      , varsigma
 , sigmau   , tau        , upsilon
 , upsilonu , phi        , varphi
 , phiu     , chi        , psi
 , psiu     , omega      , omegau
   -- ** Other symbols
 , pm , mp
 , to , mapsto, implies
 , forall , exists
 , dagger, ddagger
 , infty
 , imath, jmath
 , bot
   -- * Fonts
 , mathdefault
 , mathbf
 , mathrm
 , text
 , mathcal
 , mathsf
 , mathtt
 , mathit
   -- * Matrices
 , pmatrix  , bmatrix
 , b2matrix , vmatrix
 , v2matrix
   -- * Math spacing
 , quad, qquad
 , thinspace, medspace, thickspace, negspace, space
   ) where

import Text.LaTeX.Base
import Text.LaTeX.Base.Syntax
import Text.LaTeX.Base.Class

-- External imports
import Data.List
import Data.Ratio
import Data.Matrix

-- | AMSMath package.
-- Example:
--
-- > usepackage [] amsmath
amsmath :: PackageName
amsmath :: PackageName
amsmath = PackageName
"amsmath"


-- | A reference to a numbered equation. Use with a 'label' defined in the
-- scope of the equation refered to.
eqref :: LaTeXC l => l -> l
eqref :: l -> l
eqref = (LaTeX -> LaTeX) -> l -> l
forall l. LaTeXC l => (LaTeX -> LaTeX) -> l -> l
liftL ((LaTeX -> LaTeX) -> l -> l) -> (LaTeX -> LaTeX) -> l -> l
forall a b. (a -> b) -> a -> b
$ \LaTeX
l -> PackageName -> [TeXArg] -> LaTeX
TeXComm PackageName
"eqref" [LaTeX -> TeXArg
FixArg (LaTeX -> TeXArg) -> (Text -> LaTeX) -> Text -> TeXArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LaTeX
TeXRaw (Text -> TeXArg) -> Text -> TeXArg
forall a b. (a -> b) -> a -> b
$ LaTeX -> Text
forall a. Render a => a -> Text
render LaTeX
l]

-- | An array of aligned equations. Use '&' to specify the points that should
-- horizontally match. Each equation is numbered, unless prevented by 'nonumber'.
align :: LaTeXC l => [l] -> l
align :: [l] -> l
align = (LaTeX -> LaTeX) -> l -> l
forall l. LaTeXC l => (LaTeX -> LaTeX) -> l -> l
liftL(PackageName -> [TeXArg] -> LaTeX -> LaTeX
TeXEnv PackageName
"align" []) (l -> l) -> ([l] -> l) -> [l] -> l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [l] -> l
forall a. Monoid a => [a] -> a
mconcat ([l] -> l) -> ([l] -> [l]) -> [l] -> l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. l -> [l] -> [l]
forall a. a -> [a] -> [a]
intersperse l
forall l. LaTeXC l => l
lnbk 

-- | The unnumbered variant of 'align'.
align_ :: LaTeXC l => [l] -> l
align_ :: [l] -> l
align_ = (LaTeX -> LaTeX) -> l -> l
forall l. LaTeXC l => (LaTeX -> LaTeX) -> l -> l
liftL(PackageName -> [TeXArg] -> LaTeX -> LaTeX
TeXEnv PackageName
"align*" []) (l -> l) -> ([l] -> l) -> [l] -> l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [l] -> l
forall a. Monoid a => [a] -> a
mconcat ([l] -> l) -> ([l] -> [l]) -> [l] -> l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. l -> [l] -> [l]
forall a. a -> [a] -> [a]
intersperse l
forall l. LaTeXC l => l
lnbk 

-- | The cases environment allows the writing of piecewise functions
cases :: LaTeXC l => l -> l
cases :: l -> l
cases = (LaTeX -> LaTeX) -> l -> l
forall l. LaTeXC l => (LaTeX -> LaTeX) -> l -> l
liftL ((LaTeX -> LaTeX) -> l -> l) -> (LaTeX -> LaTeX) -> l -> l
forall a b. (a -> b) -> a -> b
$ PackageName -> [TeXArg] -> LaTeX -> LaTeX
TeXEnv PackageName
"cases" []

-------------------------------------
------- Symbols and utilities -------


-- | Like 'frac' but smaller (uses subscript size for the numerator and denominator.
tfrac :: LaTeXC l => l -> l -> l
tfrac :: l -> l -> l
tfrac = (LaTeX -> LaTeX -> LaTeX) -> l -> l -> l
forall l. LaTeXC l => (LaTeX -> LaTeX -> LaTeX) -> l -> l -> l
liftL2 ((LaTeX -> LaTeX -> LaTeX) -> l -> l -> l)
-> (LaTeX -> LaTeX -> LaTeX) -> l -> l -> l
forall a b. (a -> b) -> a -> b
$ \LaTeX
p LaTeX
q -> PackageName -> [TeXArg] -> LaTeX
TeXComm PackageName
"tfrac" [LaTeX -> TeXArg
FixArg LaTeX
p, LaTeX -> TeXArg
FixArg LaTeX
q]


-- | Add a dot accent above a symbol, as used to denote a second derivative,
--   like \(\ddot{y}\)
ddot :: LaTeXC l => l -> l
ddot :: l -> l
ddot = PackageName -> l -> l
forall l. LaTeXC l => PackageName -> l -> l
comm1 PackageName
"ddot"

-- | Add a triple dot accent above a symbol, as used to denote a third derivative,
--   like \(\dddot{z}\)
dddot :: LaTeXC l => l -> l
dddot :: l -> l
dddot = PackageName -> l -> l
forall l. LaTeXC l => PackageName -> l -> l
comm1 PackageName
"dddot"




-- | Escape from math mode, into a normal-text box.
--   Unlike 'mathrm', this won't squash spaces, i.e. you can write actual sentences.
--   You can embed 'math' again within such a box.
text :: LaTeXC l => l -> l
text :: l -> l
text = PackageName -> l -> l
forall l. LaTeXC l => PackageName -> l -> l
comm1 PackageName
"text"

-------------------------------------
------------- Matrices --------------

matrix2tex :: (Texy a, LaTeXC l) => Matrix a -> l
matrix2tex :: Matrix a -> l
matrix2tex Matrix a
m = [l] -> l
forall a. Monoid a => [a] -> a
mconcat
 [ (l -> l -> l) -> [l] -> l
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 l -> l -> l
forall l. LaTeXC l => l -> l -> l
(&) [ a -> l
forall t l. (Texy t, LaTeXC l) => t -> l
texy (a -> l) -> a -> l
forall a b. (a -> b) -> a -> b
$ Matrix a
m Matrix a -> (Int, Int) -> a
forall a. Matrix a -> (Int, Int) -> a
! (Int
i,Int
j)
     | Int
j <- [Int
1 .. Matrix a -> Int
forall a. Matrix a -> Int
ncols Matrix a
m]
     ] l -> l -> l
forall a. Semigroup a => a -> a -> a
<> l
forall l. LaTeXC l => l
lnbk
     | Int
i <- [Int
1 .. Matrix a -> Int
forall a. Matrix a -> Int
nrows Matrix a
m]
   ]

toMatrix :: (Texy a, LaTeXC l) => String -> Maybe HPos -> Matrix a -> l
toMatrix :: PackageName -> Maybe HPos -> Matrix a -> l
toMatrix PackageName
str Maybe HPos
Nothing  = (LaTeX -> LaTeX) -> l -> l
forall l. LaTeXC l => (LaTeX -> LaTeX) -> l -> l
liftL (PackageName -> [TeXArg] -> LaTeX -> LaTeX
TeXEnv PackageName
str []) (l -> l) -> (Matrix a -> l) -> Matrix a -> l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix a -> l
forall a l. (Texy a, LaTeXC l) => Matrix a -> l
matrix2tex
toMatrix PackageName
str (Just HPos
p) = (LaTeX -> LaTeX) -> l -> l
forall l. LaTeXC l => (LaTeX -> LaTeX) -> l -> l
liftL (PackageName -> [TeXArg] -> LaTeX -> LaTeX
TeXEnv (PackageName
str PackageName -> PackageName -> PackageName
forall a. [a] -> [a] -> [a]
++ PackageName
"*") [LaTeX -> TeXArg
OptArg (LaTeX -> TeXArg) -> LaTeX -> TeXArg
forall a b. (a -> b) -> a -> b
$ HPos -> LaTeX
forall a l. (Render a, LaTeXC l) => a -> l
rendertex HPos
p]) (l -> l) -> (Matrix a -> l) -> Matrix a -> l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix a -> l
forall a l. (Texy a, LaTeXC l) => Matrix a -> l
matrix2tex

-- | LaTeX rendering of a matrix using @pmatrix@ and a custom function to render cells.
--   Optional argument sets the alignment of the cells. Default (providing 'Nothing') 
--   is centered.
--
-- \[ \begin{pmatrix} 0 & 1 \\ 2 & 3 \end{pmatrix} \]
--
pmatrix :: (Texy a, LaTeXC l) => Maybe HPos -> Matrix a -> l
pmatrix :: Maybe HPos -> Matrix a -> l
pmatrix = PackageName -> Maybe HPos -> Matrix a -> l
forall a l.
(Texy a, LaTeXC l) =>
PackageName -> Maybe HPos -> Matrix a -> l
toMatrix PackageName
"pmatrix"

-- | LaTeX rendering of a matrix using @bmatrix@ and a custom function to render cells.
--   Optional argument sets the alignment of the cells. Default (providing 'Nothing') 
--   is centered.
--
-- \[ \begin{bmatrix} 0 & 1 \\ 2 & 3 \end{bmatrix} \]
--
bmatrix :: (Texy a, LaTeXC l) => Maybe HPos -> Matrix a -> l
bmatrix :: Maybe HPos -> Matrix a -> l
bmatrix = PackageName -> Maybe HPos -> Matrix a -> l
forall a l.
(Texy a, LaTeXC l) =>
PackageName -> Maybe HPos -> Matrix a -> l
toMatrix PackageName
"bmatrix"

-- | LaTeX rendering of a matrix using @Bmatrix@ and a custom function to render cells.
--   Optional argument sets the alignment of the cells. Default (providing 'Nothing') 
--   is centered.
--
-- \[ \begin{Bmatrix} 0 & 1 \\ 2 & 3 \end{Bmatrix} \]
--
b2matrix :: (Texy a, LaTeXC l) => Maybe HPos -> Matrix a -> l
b2matrix :: Maybe HPos -> Matrix a -> l
b2matrix = PackageName -> Maybe HPos -> Matrix a -> l
forall a l.
(Texy a, LaTeXC l) =>
PackageName -> Maybe HPos -> Matrix a -> l
toMatrix PackageName
"Bmatrix"

-- | LaTeX rendering of a matrix using @vmatrix@ and a custom function to render cells.
--   Optional argument sets the alignment of the cells. Default (providing 'Nothing') 
--   is centered.
--
-- \[ \begin{vmatrix} 0 & 1 \\ 2 & 3 \end{vmatrix} \]
--
vmatrix :: (Texy a, LaTeXC l) => Maybe HPos -> Matrix a -> l
vmatrix :: Maybe HPos -> Matrix a -> l
vmatrix = PackageName -> Maybe HPos -> Matrix a -> l
forall a l.
(Texy a, LaTeXC l) =>
PackageName -> Maybe HPos -> Matrix a -> l
toMatrix PackageName
"vmatrix"

-- | LaTeX rendering of a matrix using @Vmatrix@ and a custom function to render cells.
--   Optional argument sets the alignment of the cells. Default (providing 'Nothing') 
--   is centered.
--
-- \[ \begin{Vmatrix} 0 & 1 \\ 2 & 3 \end{Vmatrix} \]
--
v2matrix :: (Texy a, LaTeXC l) => Maybe HPos -> Matrix a -> l
v2matrix :: Maybe HPos -> Matrix a -> l
v2matrix = PackageName -> Maybe HPos -> Matrix a -> l
forall a l.
(Texy a, LaTeXC l) =>
PackageName -> Maybe HPos -> Matrix a -> l
toMatrix PackageName
"Vmatrix"

-------------------------------------
---------- Texy instances -----------

-- | Instance defined in "Text.LaTeX.Packages.AMSMath".
#if MIN_VERSION_base(4,9,0)
instance Texy a => Texy (Ratio a) where
#else
instance (Integral a, Texy a) => Texy (Ratio a) where
#endif
 texy :: Ratio a -> l
texy Ratio a
x = l -> l -> l
forall l. LaTeXC l => l -> l -> l
frac (a -> l
forall t l. (Texy t, LaTeXC l) => t -> l
texy (a -> l) -> a -> l
forall a b. (a -> b) -> a -> b
$ Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
x) (a -> l
forall t l. (Texy t, LaTeXC l) => t -> l
texy (a -> l) -> a -> l
forall a b. (a -> b) -> a -> b
$ Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
x)

-- | Instance defined in "Text.LaTeX.Packages.AMSMath".
instance (Texy a, Texy b) => Texy (a,b) where
 texy :: (a, b) -> l
texy (a
x,b
y) = l -> l
forall l. LaTeXC l => l -> l
autoParens (l -> l) -> l -> l
forall a b. (a -> b) -> a -> b
$ a -> l
forall t l. (Texy t, LaTeXC l) => t -> l
texy a
x l -> l -> l
forall a. Semigroup a => a -> a -> a
<> l
"," l -> l -> l
forall a. Semigroup a => a -> a -> a
<> b -> l
forall t l. (Texy t, LaTeXC l) => t -> l
texy b
y
 
-- | Instance defined in "Text.LaTeX.Packages.AMSMath".
instance (Texy a, Texy b, Texy c) => Texy (a,b,c) where
 texy :: (a, b, c) -> l
texy (a
x,b
y,c
z) = l -> l
forall l. LaTeXC l => l -> l
autoParens (l -> l) -> l -> l
forall a b. (a -> b) -> a -> b
$ a -> l
forall t l. (Texy t, LaTeXC l) => t -> l
texy a
x l -> l -> l
forall a. Semigroup a => a -> a -> a
<> l
"," l -> l -> l
forall a. Semigroup a => a -> a -> a
<> b -> l
forall t l. (Texy t, LaTeXC l) => t -> l
texy b
y l -> l -> l
forall a. Semigroup a => a -> a -> a
<> l
"," l -> l -> l
forall a. Semigroup a => a -> a -> a
<> c -> l
forall t l. (Texy t, LaTeXC l) => t -> l
texy c
z

-- | Instance defined in "Text.LaTeX.Packages.AMSMath".
instance (Texy a, Texy b, Texy c, Texy d) => Texy (a,b,c,d) where
 texy :: (a, b, c, d) -> l
texy (a
a,b
b,c
c,d
d) = l -> l
forall l. LaTeXC l => l -> l
autoParens (l -> l) -> l -> l
forall a b. (a -> b) -> a -> b
$ a -> l
forall t l. (Texy t, LaTeXC l) => t -> l
texy a
a l -> l -> l
forall a. Semigroup a => a -> a -> a
<> l
"," l -> l -> l
forall a. Semigroup a => a -> a -> a
<> b -> l
forall t l. (Texy t, LaTeXC l) => t -> l
texy b
b l -> l -> l
forall a. Semigroup a => a -> a -> a
<> l
"," l -> l -> l
forall a. Semigroup a => a -> a -> a
<> c -> l
forall t l. (Texy t, LaTeXC l) => t -> l
texy c
c l -> l -> l
forall a. Semigroup a => a -> a -> a
<> l
"," l -> l -> l
forall a. Semigroup a => a -> a -> a
<> d -> l
forall t l. (Texy t, LaTeXC l) => t -> l
texy d
d

-- | Instance defined in "Text.LaTeX.Packages.AMSMath".
instance Texy a => Texy (Matrix a) where
 texy :: Matrix a -> l
texy = Maybe HPos -> Matrix a -> l
forall a l. (Texy a, LaTeXC l) => Maybe HPos -> Matrix a -> l
pmatrix Maybe HPos
forall a. Maybe a
Nothing

-- | Instance defined in "Text.LaTeX.Packages.AMSMath".
instance Texy a => Texy [a] where
 texy :: [a] -> l
texy = l -> l
forall l. LaTeXC l => l -> l
autoSquareBrackets (l -> l) -> ([a] -> l) -> [a] -> l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [l] -> l
forall a. Monoid a => [a] -> a
mconcat ([l] -> l) -> ([a] -> [l]) -> [a] -> l
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  l -> [l] -> [l]
forall a. a -> [a] -> [a]
intersperse l
"," ([l] -> [l]) -> ([a] -> [l]) -> [a] -> [l]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (a -> l) -> [a] -> [l]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> l
forall t l. (Texy t, LaTeXC l) => t -> l
texy

-------------------------------------
----------- Math Spacing-------------

-- | @\,@ space equal to 3/18 of \quad (= 3 mu). \(a\,b\)
thinspace :: LaTeXC l => l
thinspace :: l
thinspace = PackageName -> l
forall l. LaTeXC l => PackageName -> l
comm0 PackageName
","

-- | @\:@ space equal to 4/18 of \quad (= 4 mu). \(a\:b\)
medspace :: LaTeXC l => l
medspace :: l
medspace = PackageName -> l
forall l. LaTeXC l => PackageName -> l
comm0 PackageName
":"

-- | @\:@ space equal to 5/18 of \quad (= 5 mu). \(a\;b\)
thickspace :: LaTeXC l => l
thickspace :: l
thickspace = PackageName -> l
forall l. LaTeXC l => PackageName -> l
comm0 PackageName
";"

-- | @\!@ space equal to -3/18 of \quad (= -3 mu). \(a\!b\)
negspace :: LaTeXC l => l
negspace :: l
negspace = PackageName -> l
forall l. LaTeXC l => PackageName -> l
comm0 PackageName
"!"

-- | @\ @ (space after backslash) equivalent of space in normal text. \(a\ b\)
space :: LaTeXC l => l
space :: l
space = PackageName -> l
forall l. LaTeXC l => PackageName -> l
comm0 PackageName
" "