-- | Defines helper functions used in printing LaTeX documents.
module Language.Drasil.TeX.Helpers where

import Text.PrettyPrint (text)
import qualified Text.PrettyPrint as TP

import Language.Drasil (MaxWidthPercent)

import Language.Drasil.Config (numberedSections, hyperSettings)
import qualified Language.Drasil.Printing.Helpers as H
import Language.Drasil.TeX.Monad (PrintLaTeX(PL), D, MathContext(Math), ($+$))
import Data.List (isSuffixOf)

--import Language.Drasil.Config (numberedSections, hyperSettings)
--import Language.Drasil.Document (MaxWidthPercent)

-----------------------------------------------------------------------------
-- * LaTeX Commands
--
-- $latexCmd
--
-- Infrastructre for defining commands, environments, etc.
-- Calls to TP should only occur in this section.

-- | Helper for adding fencing symbols.
br, sq, parens, quote :: D -> D
-- | Curly braces.
br :: D -> D
br x :: D
x = D
lb D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D
x D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D
rb
  where
  lb :: D
lb = Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "{"
  rb :: D
rb = Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "}"
-- | Square brackets.
sq :: D -> D
sq x :: D
x = D
ls D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D
x D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D
rs
  where
  ls :: D
ls = Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "["
  rs :: D
rs = Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "]"
-- | Parenthesis.
parens :: D -> D
parens x :: D
x = D
lp D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D
x D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D
rp
  where
  lp :: D
lp = Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "("
  rp :: D
rp = Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ String -> Doc
text ")"
-- | Quotes.
quote :: D -> D
quote x :: D
x = D
lq D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D
x D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D
rq
  where
  lq :: D
lq = Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "``"
  rq :: D
rq = Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "''"

-- | 0-argument command.
command0 :: String -> D
command0 :: String -> D
command0 s :: String
s = Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ Doc
H.bslash Doc -> Doc -> Doc
TP.<> String -> Doc
text String
s

-- | Make 1-argument command.
command :: String -> String -> D
command :: String -> String -> D
command s :: String
s c :: String
c = Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ (Doc
H.bslash Doc -> Doc -> Doc
TP.<> String -> Doc
text String
s) Doc -> Doc -> Doc
TP.<> String -> Doc
H.br String
c

-- | Similar to 'command', but uses 'br' for braces.
commandD :: String -> D -> D
commandD :: String -> D -> D
commandD s :: String
s c :: D
c = Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
H.bslash Doc -> Doc -> Doc
TP.<> String -> Doc
text String
s) D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D -> D
br D
c

-- | 1-argument command, with optional argument.
command1o :: String -> Maybe String -> String -> D
command1o :: String -> Maybe String -> String -> D
command1o s :: String
s = (String -> D)
-> (String -> String -> D) -> Maybe String -> String -> D
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> String -> D
command String
s) (String -> String -> String -> D
command1p String
s)

-- | Similar to 'command1o', but uses 'sq' and 'br' for brackets.
command1oD :: String -> Maybe D -> D -> D
command1oD :: String -> Maybe D -> D -> D
command1oD s :: String
s = (D -> D) -> (D -> D -> D) -> Maybe D -> D -> D
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> D -> D
commandD String
s) (String -> D -> D -> D
command1pD String
s)

-- | 1-argument command with parameter in square brackets.
command1p :: String -> String -> String -> D
command1p :: String -> String -> String -> D
command1p s :: String
s p :: String
p c :: String
c = Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ (Doc
H.bslash Doc -> Doc -> Doc
TP.<> String -> Doc
text String
s) Doc -> Doc -> Doc
TP.<> String -> Doc
H.sq String
p Doc -> Doc -> Doc
TP.<> String -> Doc
H.br String
c

-- | Similar to 'command1p', but uses 'sq' and 'br' for brackets.
command1pD :: String -> D -> D -> D
command1pD :: String -> D -> D -> D
command1pD s :: String
s p :: D
p c :: D
c = Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
H.bslash Doc -> Doc -> Doc
TP.<> String -> Doc
text String
s) D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D -> D
sq D
p D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D -> D
br D
c

-- | Make LaTeX symbol.
texSym :: String -> D
texSym :: String -> D
texSym s :: String
s = Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ Doc
H.bslash Doc -> Doc -> Doc
TP.<> String -> Doc
text String
s

-- | 2-argument command.
command2 :: String -> String -> String -> D
command2 :: String -> String -> String -> D
command2 s :: String
s a0 :: String
a0 a1 :: String
a1 = Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ (Doc
H.bslash Doc -> Doc -> Doc
TP.<> String -> Doc
text String
s) Doc -> Doc -> Doc
TP.<> String -> Doc
H.br String
a0 Doc -> Doc -> Doc
TP.<> String -> Doc
H.br String
a1

-- | Similar to 'command2', but uses 'br' for brackets.
command2D :: String -> D -> D -> D
command2D :: String -> D -> D -> D
command2D s :: String
s a0 :: D
a0 a1 :: D
a1 = Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc
H.bslash Doc -> Doc -> Doc
TP.<> String -> Doc
text String
s) D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D -> D
br D
a0 D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D -> D
br D
a1

-- | 3-argument command.
command3 :: String -> String -> String -> String -> D
command3 :: String -> String -> String -> String -> D
command3 s :: String
s a0 :: String
a0 a1 :: String
a1 a2 :: String
a2 = Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ (Doc
H.bslash Doc -> Doc -> Doc
TP.<> String -> Doc
text String
s) Doc -> Doc -> Doc
TP.<> String -> Doc
H.br String
a0 Doc -> Doc -> Doc
TP.<> String -> Doc
H.br String
a1 Doc -> Doc -> Doc
TP.<> String -> Doc
H.br String
a2

-- | Encapsulate environments.
mkEnv :: String -> D -> D
mkEnv :: String -> D -> D
mkEnv nm :: String
nm d :: D
d =
  Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text ("\\begin" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
H.brace String
nm)) D -> D -> D
$+$ 
  D
d D -> D -> D
$+$
  Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text ("\\end" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
H.brace String
nm))

-- | Encapsulate environments with argument with braces.
mkEnvArgBr :: String -> String -> D -> D
mkEnvArgBr :: String -> String -> D -> D
mkEnvArgBr nm :: String
nm args :: String
args d :: D
d =
  Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text ("\\begin" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
H.brace String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
H.brace String
args)) D -> D -> D
$+$ 
  D
d D -> D -> D
$+$
  Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text ("\\end" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
H.brace String
nm))

-- | Encapsulate environments with argument with brackets.
mkEnvArgSq :: String -> String -> D -> D
mkEnvArgSq :: String -> String -> D -> D
mkEnvArgSq nm :: String
nm args :: String
args d :: D
d =
  Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text ("\\begin" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
H.brace String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
H.sqbrac String
args)) D -> D -> D
$+$ 
  D
d D -> D -> D
$+$
  Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text ("\\end" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
H.brace String
nm))

-- | Makes minipage environment.
mkMinipage :: D -> D
mkMinipage :: D -> D
mkMinipage d :: D
d = String -> D -> D
commandD "vspace" (String -> D
command0 "baselineskip") D -> D -> D
$+$
  String -> D
command0 "noindent" D -> D -> D
$+$ String -> String -> D -> D
mkEnvArgBr "minipage" "\\textwidth" D
d

-- | For defining (LaTeX) macros.
comm :: String -> String -> Maybe String -> D
comm :: String -> String -> Maybe String -> D
comm b1 :: String
b1 b2 :: String
b2 s1 :: Maybe String
s1 = String -> D
command0 "newcommand" D -> D -> D
forall a. Semigroup a => a -> a -> a
<> Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
H.br ("\\" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b1) Doc -> Doc -> Doc
TP.<> 
  Doc -> (String -> Doc) -> Maybe String -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
TP.empty String -> Doc
H.sq Maybe String
s1 Doc -> Doc -> Doc
TP.<> String -> Doc
H.br String
b2)

-- this one is special enough, let this sub-optimal implementation stand
-- | Renews given command.
renewcomm :: String -> String -> D
renewcomm :: String -> String -> D
renewcomm b1 :: String
b1 = String -> String -> String -> D
command2 "renewcommand" ("\\" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b1)

-- | Useful to have an empty case.
empty :: D
empty :: D
empty = Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
TP.empty

-- | For sections.
genSec :: Int -> D
genSec :: Int -> D
genSec d :: Int
d
  | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = String -> D
forall a. HasCallStack => String -> a
error "Cannot have section with negative depth"
  | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 3 = String -> D
forall a. HasCallStack => String -> a
error "Section depth must be from 0-2"
  | Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 3 = Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ Doc
H.bslash Doc -> Doc -> Doc
TP.<> String -> Doc
text "paragraph"
  | Bool
otherwise = Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ 
     Doc
H.bslash Doc -> Doc -> Doc
TP.<> String -> Doc
text ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
d "sub") Doc -> Doc -> Doc
TP.<> String -> Doc
text "section" 
      Doc -> Doc -> Doc
TP.<> (if Bool -> Bool
not Bool
numberedSections then String -> Doc
text "*" else Doc
TP.empty) 

-- | For references.
ref, sref, hyperref, externalref, snref :: String -> D -> D
sref :: String -> D -> D
sref            = if Bool
numberedSections then String -> D -> D
ref else String -> D -> D
hyperref
ref :: String -> D -> D
ref         t :: String
t x :: D
x = Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ "~") D -> D -> D
forall a. Semigroup a => a -> a -> a
<> String -> D -> D
commandD "ref" D
x
hyperref :: String -> D -> D
hyperref    t :: String
t x :: D
x = String -> D -> D -> D
command1pD "hyperref" D
x (Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text (String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ "~")) D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D
x)
externalref :: String -> D -> D
externalref t :: String
t x :: D
x = String -> D
command0 "hyperref" D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D -> D
br (Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
t) D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D -> D
br D
empty D -> D -> D
forall a. Semigroup a => a -> a -> a
<>
  D -> D
br D
empty D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D -> D
br D
x
snref :: String -> D -> D
snref       r :: String
r   = String -> D -> D -> D
command1pD "hyperref" (Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text String
r))

-- | For references.
href :: String -> String -> D
href :: String -> String -> D
href = String -> String -> String -> D
command2 "href"

-- | For citations.
cite :: String -> Maybe D -> D
cite :: String -> Maybe D -> D
cite c :: String
c n :: Maybe D
n = String -> Maybe D -> D -> D
command1oD "cite" Maybe D
n (Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> D) -> Doc -> D
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
c) --may need to be changed to allow for shortnames?

-----------------------------------------------------------------------------
-- * Define Common LaTeX Commands

count, mathbb, usepackage :: String -> D
-- | Newcounter command.
count :: String -> D
count      = String -> String -> D
command "newcounter"
-- changed to command "newcounter" from command "count" (I assume this was
-- what was intended?)
-- | Mathbb command.
mathbb :: String -> D
mathbb     = String -> String -> D
command "mathbb"
-- | Usepackage command.
usepackage :: String -> D
usepackage = String -> String -> D
command "usepackage"

-- | Include graphics with a given max width percentage.
includegraphics :: MaxWidthPercent -> String -> D
includegraphics :: MaxWidthPercent -> String -> D
includegraphics n :: MaxWidthPercent
n fp :: String
fp 
  | ".svg" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
fp = String -> String -> String -> D
command1p "includesvg" ("width=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ MaxWidthPercent -> String
forall a. (Eq a, Show a, Fractional a) => a -> String
per MaxWidthPercent
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\\textwidth, inkscapelatex = false") String
fpNoSvg -- in order to use inkscape to render svgs, there can't be a file type appended
  | Bool
otherwise = String -> String -> String -> D
command1p "includegraphics" ("width=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ MaxWidthPercent -> String
forall a. (Eq a, Show a, Fractional a) => a -> String
per MaxWidthPercent
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\\textwidth") String
fp -- still need a case for normal images
  where
    fpNoSvg :: String
fpNoSvg = Int -> String -> String
forall a. Int -> [a] -> [a]
take (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
fp Int -> Int -> Int
forall a. Num a => a -> a -> a
- 4) String
fp
    per :: a -> String
per 100 = ""
    per wp :: a
wp  = a -> String
forall a. Show a => a -> String
show (a
wp a -> a -> a
forall a. Fractional a => a -> a -> a
/ 100)

-- | Preamble for a LaTeX document.
author, caption, item, label, title, bold :: D -> D
author :: D -> D
author  = String -> D -> D
commandD "author"
caption :: D -> D
caption = String -> D -> D
commandD "caption"
item :: D -> D
item    = String -> D -> D
commandD "item"
label :: D -> D
label   = String -> D -> D
commandD "label"
title :: D -> D
title   = String -> D -> D
commandD "title"
bold :: D -> D
bold    = String -> D -> D
commandD "textbf"

-- | Command for "item".
item' :: D -> D -> D
item' :: D -> D -> D
item' = String -> D -> D -> D
command1pD "item"

-- | Formatting options for a LaTeX document.
maketitle, maketoc, newpage, centering :: D
maketitle :: D
maketitle = String -> D
command0 "maketitle"
maketoc :: D
maketoc   = String -> D
command0 "tableofcontents"
newpage :: D
newpage   = String -> D
command0 "newpage"
centering :: D
centering = String -> D
command0 "centering"

-- | Common commands and formatting options for a LaTeX document.
code, itemize, enumerate, description, figure, center, document, 
  equation, symbDescription :: D -> D
code :: D -> D
code        = String -> D -> D
mkEnv "lstlisting"
itemize :: D -> D
itemize     = String -> D -> D
mkEnv "itemize"
enumerate :: D -> D
enumerate   = String -> D -> D
mkEnv "enumerate"
description :: D -> D
description = String -> D -> D
mkEnv "description"
figure :: D -> D
figure      = String -> D -> D
mkEnv "figure"
center :: D -> D
center      = String -> D -> D
mkEnv "center"
document :: D -> D
document    = String -> D -> D
mkEnv "document"
equation :: D -> D
equation    = String -> D -> D
mkEnv "displaymath" --displays math
symbDescription :: D -> D
symbDescription = String -> D -> D
mkEnv "symbDescription"

-- | Command for the document class.
docclass :: String -> String -> D
docclass :: String -> String -> D
docclass = String -> String -> String -> D
command1p "documentclass"

-- | General section function.
sec :: Int -> D -> D
sec :: Int -> D -> D
sec d :: Int
d b1 :: D
b1 = Int -> D
genSec Int
d D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D -> D
br D
b1

subscript, superscript :: D -> D -> D
-- | Makes second argument a subscript of the first argument.
subscript :: D -> D -> D
subscript   a :: D
a b :: D
b = D
a D -> D -> D
forall a. Semigroup a => a -> a -> a
<> Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
H.unders D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D -> D
br D
b
-- | Makes second argument a superscript of the first argument.
superscript :: D -> D -> D
superscript a :: D
a b :: D
b = D
a D -> D -> D
forall a. Semigroup a => a -> a -> a
<> Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
H.hat    D -> D -> D
forall a. Semigroup a => a -> a -> a
<> D -> D
br D
b

-- grave, acute :: Char -> D
-- grave c = (pure $ text "\\`{") <> pure (TP.char c) <> (pure $ text "}")
-- acute c = (pure $ text "\\'{") <> pure (TP.char c) <> (pure $ text "}")

-- Macro / Command def'n --
--TeX--
-- | Macro/Command definitions.
bullet, counter, ddefnum, ddref, colAw, colBw, arrayS, modcounter, modnum :: D

counter :: D
counter    = String -> D
count "datadefnum"
modcounter :: D
modcounter = String -> D
count "modnum"

bullet :: D
bullet  = String -> String -> Maybe String -> D
comm "blt"             "- "                Maybe String
forall a. Maybe a
Nothing
ddefnum :: D
ddefnum = String -> String -> Maybe String -> D
comm "ddthedatadefnum" "MG\\thedatadefnum" Maybe String
forall a. Maybe a
Nothing
ddref :: D
ddref   = String -> String -> Maybe String -> D
comm "ddref"           "MG\\ref{#1}"       (String -> Maybe String
forall a. a -> Maybe a
Just "1")
colAw :: D
colAw   = String -> String -> Maybe String -> D
comm "colAwidth"       "0.2\\textwidth"    Maybe String
forall a. Maybe a
Nothing
colBw :: D
colBw   = String -> String -> Maybe String -> D
comm "colBwidth"       "0.73\\textwidth"   Maybe String
forall a. Maybe a
Nothing
modnum :: D
modnum  = String -> String -> Maybe String -> D
comm "mthemodnum"      "M\\themodnum"      Maybe String
forall a. Maybe a
Nothing

arrayS :: D
arrayS  = String -> String -> D
renewcomm "arraystretch" "1.2"

-- | Add newline.
newline :: D -> D
newline :: D -> D
newline s :: D
s = D
s D -> D -> D
$+$ Doc -> D
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
text "")

-- | Create a fraction.
fraction :: D -> D -> D
fraction :: D -> D -> D
fraction = String -> D -> D -> D
command2D "frac"

-- | Configuration settings.
hyperConfig :: D
hyperConfig :: D
hyperConfig = String -> String -> D
command "hypersetup" String
hyperSettings

-- | Uses luatex85 tex packages.
useTikz :: D
useTikz :: D
useTikz = String -> D
usepackage "luatex85" D -> D -> D
$+$ String -> D
command0 "def" D -> D -> D
forall a. Semigroup a => a -> a -> a
<>
  String -> String -> D
command "pgfsysdriver" "pgfsys-pdftex.def" D -> D -> D
$+$
  -- the above is a workaround..  temporary until TeX packages have been fixed
  String -> D
usepackage "tikz" D -> D -> D
$+$ String -> String -> D
command "usetikzlibrary" "arrows.meta" D -> D -> D
$+$
  String -> String -> D
command "usetikzlibrary" "graphs" D -> D -> D
$+$ String -> String -> D
command "usetikzlibrary" "graphdrawing" D -> D -> D
$+$
  String -> String -> D
command "usegdlibrary" "layered"
  
-- * Helpers

-----------------------------------------------------------------------------
-- This 'belongs' in Monad, but it would make Monad depend on Helpers, which depends
-- on Monad...

-- | toEqn is special; it switches to 'Math', but inserts an equation environment.
toEqn :: D -> D
toEqn :: D -> D
toEqn (PL g :: MathContext -> Doc
g) = D -> D
equation (D -> D) -> D -> D
forall a b. (a -> b) -> a -> b
$ (MathContext -> Doc) -> D
forall a. (MathContext -> a) -> PrintLaTeX a
PL (\_ -> MathContext -> Doc
g MathContext
Math)

-----------------------------------------------------------------------------
-- | Helper(s) for String-Printing in TeX where it varies from HTML/Plaintext.
paren, sqbrac :: String -> String
-- | Wrap with parenthesis.
paren :: String -> String
paren x :: String
x = "\\left(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\\right)"
-- | Wrap with square brackets.
sqbrac :: String -> String
sqbrac x :: String
x = "\\left[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\\right]"