{-# LANGUAGE CPP #-}

-- | Module for the package @amsfonts@.
module Text.LaTeX.Packages.AMSFonts
 ( -- * AMSFonts package
   amsfonts
   -- * Fonts
 , mathbb, mathfrak
   -- * Number sets
 , naturals, integers, rationals, reals, quaternions
   -- ** Complex numbers
 , complexes, trealPart, timagPart
   ) where

import Text.LaTeX.Base.Class
import Text.LaTeX.Base.Types
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid
#endif

-- | AMSFonts package.
-- Example:
--
-- > usepackage [] amsfonts
amsfonts :: ClassName
amsfonts :: ClassName
amsfonts = ClassName
"amsfonts"

--

-- | This font is useful for representing sets like
--   \(\mathbb{R}\) (real numbers) or \(\mathbb{Z}\) (integers). For instance:
--
-- > "The set of real numbers are represented by " <> mathbb "R" <> "."
--
-- Or in monadic form:
--
-- > "The set of real numbers are represented by " >> mathbb "R" >> "."
--
-- /Note the use of overloaded strings./
mathbb :: LaTeXC l => l -> l
mathbb :: forall l. LaTeXC l => l -> l
mathbb = forall l. LaTeXC l => ClassName -> l -> l
comm1 ClassName
"mathbb"

-- | Fraktur font, like \(\mathfrak{abcXYZ}\).
mathfrak :: LaTeXC l => l -> l
mathfrak :: forall l. LaTeXC l => l -> l
mathfrak = forall l. LaTeXC l => ClassName -> l -> l
comm1 ClassName
"mathfrak"

-- | \(\mathbb{N}\)
naturals :: LaTeXC l => l
naturals :: forall l. LaTeXC l => l
naturals = forall l. LaTeXC l => l -> l
mathbb l
"N"

-- | \(\mathbb{Z}\)
integers :: LaTeXC l => l
integers :: forall l. LaTeXC l => l
integers = forall l. LaTeXC l => l -> l
mathbb l
"Z"

-- | \(\mathbb{Q}\)
rationals :: LaTeXC l => l
rationals :: forall l. LaTeXC l => l
rationals = forall l. LaTeXC l => l -> l
mathbb l
"Q"

-- | \(\mathbb{R}\)
reals :: LaTeXC l => l
reals :: forall l. LaTeXC l => l
reals = forall l. LaTeXC l => l -> l
mathbb l
"R"

-- | \(\mathbb{C}\)
complexes :: LaTeXC l => l
complexes :: forall l. LaTeXC l => l
complexes = forall l. LaTeXC l => l -> l
mathbb l
"C"

-- | \(\mathbb{H}\)
quaternions :: LaTeXC l => l
quaternions :: forall l. LaTeXC l => l
quaternions = forall l. LaTeXC l => l -> l
mathbb l
"H"

-- | \(\Re\)
trealPart :: LaTeXC l => l -> l
trealPart :: forall l. LaTeXC l => l -> l
trealPart l
z = forall l. LaTeXC l => ClassName -> l
comm0 ClassName
"Re" forall a. Semigroup a => a -> a -> a
<> l
z

-- | \(\Im\)
timagPart :: LaTeXC l => l -> l
timagPart :: forall l. LaTeXC l => l -> l
timagPart l
z = forall l. LaTeXC l => ClassName -> l
comm0 ClassName
"Im" forall a. Semigroup a => a -> a -> a
<> l
z