{-# Language FlexibleInstances #-}
-- | Printing Monad. Starts with a specific data type (reader monad) and extends from there.
module Language.Drasil.TeX.Monad where

import Prelude hiding (print)
import qualified Text.PrettyPrint as TP

import Language.Drasil

import Control.Applicative hiding (empty)

import qualified Language.Drasil.Printing.Helpers as H

-----------------------------------------------------------------------------
-- * Printing Monad

-- first, start with a specific data type
-- note that this is just the Reader Monad for now, but we might need
-- to extend, so start there.

-- | There are two proper contexts, Text and Math; Curr is the current context.
-- There are multiple ways of getting there: for Text, either being at the top-level 
-- or inside \text. For Math, either surrounded by $ or 
-- in \begin{equation} .. \end{equation}.
-- Curr is when the current context is fine.
data MathContext = Text | Math | Curr deriving MathContext -> MathContext -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MathContext -> MathContext -> Bool
$c/= :: MathContext -> MathContext -> Bool
== :: MathContext -> MathContext -> Bool
$c== :: MathContext -> MathContext -> Bool
Eq

-- | A monad for printing in LaTeX.
newtype PrintLaTeX a = PL { forall a. PrintLaTeX a -> MathContext -> a
runPrint :: MathContext -> a }

-- | Defines the printing monad as a functor.
instance Functor PrintLaTeX where
  fmap :: forall a b. (a -> b) -> PrintLaTeX a -> PrintLaTeX b
fmap a -> b
f (PL MathContext -> a
ca) = forall a. (MathContext -> a) -> PrintLaTeX a
PL forall a b. (a -> b) -> a -> b
$ \MathContext
ctx -> a -> b
f (MathContext -> a
ca MathContext
ctx)

-- | This printing monad is also applicative.
instance Applicative PrintLaTeX where
  pure :: forall a. a -> PrintLaTeX a
pure = forall a. (MathContext -> a) -> PrintLaTeX a
PL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
  PL MathContext -> a -> b
f <*> :: forall a b. PrintLaTeX (a -> b) -> PrintLaTeX a -> PrintLaTeX b
<*> PL MathContext -> a
v = forall a. (MathContext -> a) -> PrintLaTeX a
PL forall a b. (a -> b) -> a -> b
$ \MathContext
ctx -> MathContext -> a -> b
f MathContext
ctx (MathContext -> a
v MathContext
ctx)

-- | Define the printing monad.
instance Monad PrintLaTeX where
  return :: forall a. a -> PrintLaTeX a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  PrintLaTeX a
m >>= :: forall a b. PrintLaTeX a -> (a -> PrintLaTeX b) -> PrintLaTeX b
>>= a -> PrintLaTeX b
k = forall a. (MathContext -> a) -> PrintLaTeX a
PL forall a b. (a -> b) -> a -> b
$ \MathContext
ctx -> 
    let a :: a
a = forall a. PrintLaTeX a -> MathContext -> a
runPrint PrintLaTeX a
m MathContext
ctx in
    forall a. PrintLaTeX a -> MathContext -> a
runPrint (a -> PrintLaTeX b
k a
a) MathContext
ctx

-- | Convenient abbreviation.
type D = PrintLaTeX TP.Doc

-- | MonadReader calls this @local@.
-- Can switch contexts (including no-switch cases).  Adjust printing as necessary.
switch :: (MathContext -> MathContext) -> D -> D
switch :: (MathContext -> MathContext) -> PrintLaTeX Doc -> PrintLaTeX Doc
switch MathContext -> MathContext
f (PL MathContext -> Doc
g) = forall a. (MathContext -> a) -> PrintLaTeX a
PL forall a b. (a -> b) -> a -> b
$ \MathContext
c -> MathContext -> MathContext -> (MathContext -> Doc) -> Doc
adjust MathContext
c (MathContext -> MathContext
f MathContext
c) MathContext -> Doc
g
  where
    bstext :: Doc
bstext = String -> Doc
TP.text String
"\\text"
    br :: Doc -> Doc
br Doc
doc = String -> Doc
TP.text String
"{" Doc -> Doc -> Doc
TP.<> Doc
doc Doc -> Doc -> Doc
TP.<> String -> Doc
TP.text String
"}"
    adjust :: MathContext -> MathContext -> (MathContext -> TP.Doc) -> TP.Doc
    adjust :: MathContext -> MathContext -> (MathContext -> Doc) -> Doc
adjust MathContext
Math MathContext
Math MathContext -> Doc
gen = MathContext -> Doc
gen MathContext
Math
    adjust MathContext
Text MathContext
Text MathContext -> Doc
gen = MathContext -> Doc
gen MathContext
Text
    -- we are producing Math, but want some Text embedded
    adjust MathContext
Math MathContext
Text MathContext -> Doc
gen = Doc
bstext Doc -> Doc -> Doc
TP.<> Doc -> Doc
br (MathContext -> Doc
gen MathContext
Text)
    -- we are producing Text, but want some Math embedded
    adjust MathContext
Text MathContext
Math MathContext -> Doc
gen = Doc -> Doc
H.dollarDoc forall a b. (a -> b) -> a -> b
$ MathContext -> Doc
gen MathContext
Math
    adjust MathContext
Curr MathContext
Curr MathContext -> Doc
gen = MathContext -> Doc
gen MathContext
Text -- default
    adjust MathContext
Curr MathContext
x MathContext -> Doc
gen = MathContext -> Doc
gen MathContext
x
    adjust MathContext
x MathContext
Curr MathContext -> Doc
gen = MathContext -> Doc
gen MathContext
x 

toMath, toText :: D -> D
-- | Change context to Math.
toMath :: PrintLaTeX Doc -> PrintLaTeX Doc
toMath = (MathContext -> MathContext) -> PrintLaTeX Doc -> PrintLaTeX Doc
switch (forall a b. a -> b -> a
const MathContext
Math)
-- | Change context to Text.
toText :: PrintLaTeX Doc -> PrintLaTeX Doc
toText = (MathContext -> MathContext) -> PrintLaTeX Doc -> PrintLaTeX Doc
switch (forall a b. a -> b -> a
const MathContext
Text)

-- | MonadReader calls this @ask@.
getCtx :: PrintLaTeX MathContext
getCtx :: PrintLaTeX MathContext
getCtx = forall a. (MathContext -> a) -> PrintLaTeX a
PL forall a. a -> a
id

-- | D is a member of Semigroup.
instance Semigroup (PrintLaTeX TP.Doc) where
  (PL MathContext -> Doc
s1) <> :: PrintLaTeX Doc -> PrintLaTeX Doc -> PrintLaTeX Doc
<> (PL MathContext -> Doc
s2) = forall a. (MathContext -> a) -> PrintLaTeX a
PL forall a b. (a -> b) -> a -> b
$ \MathContext
ctx -> MathContext -> Doc
s1 MathContext
ctx Doc -> Doc -> Doc
TP.<> MathContext -> Doc
s2 MathContext
ctx

-- | D is a monoid.
instance Monoid (PrintLaTeX TP.Doc) where
  mempty :: PrintLaTeX Doc
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc
TP.empty

-- may revisit later
-- | Since Text.PrettyPrint steals <>, use %% instead for $$.
infixl 5 %%
(%%) :: D -> D -> D
%% :: PrintLaTeX Doc -> PrintLaTeX Doc -> PrintLaTeX Doc
(%%) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Doc -> Doc -> Doc
(TP.$$)

-- | Lifts Text.PrettyPrint's $+$. Above, with no overlapping. Associative.
infixr 6 $+$
($+$) :: D -> D -> D
$+$ :: PrintLaTeX Doc -> PrintLaTeX Doc -> PrintLaTeX Doc
($+$) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Doc -> Doc -> Doc
(TP.$+$)

-- | Concatenates a list of 'D' using a function from ['TP.Doc'] -> 'TP.Doc'.
tpRunPrint :: ([TP.Doc] -> TP.Doc) -> [D] -> D
tpRunPrint :: ([Doc] -> Doc) -> [PrintLaTeX Doc] -> PrintLaTeX Doc
tpRunPrint [Doc] -> Doc
f [PrintLaTeX Doc]
l = forall a. (MathContext -> a) -> PrintLaTeX a
PL forall a b. (a -> b) -> a -> b
$ \MathContext
ctx -> [Doc] -> Doc
f forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. PrintLaTeX a -> MathContext -> a
`runPrint` MathContext
ctx) [PrintLaTeX Doc]
l

-- | List version of 'TP.$$'. Above, except that if the last line of the first
-- argument stops at least one position before the first line of the second begins,
-- these two lines are overlapped.
vcat :: [D] -> D
vcat :: [PrintLaTeX Doc] -> PrintLaTeX Doc
vcat = ([Doc] -> Doc) -> [PrintLaTeX Doc] -> PrintLaTeX Doc
tpRunPrint [Doc] -> Doc
TP.vcat

-- Combine 'TP.vcat' and 'TP.punctuate'.
vpunctuate :: TP.Doc -> [D] -> D
vpunctuate :: Doc -> [PrintLaTeX Doc] -> PrintLaTeX Doc
vpunctuate Doc
x = ([Doc] -> Doc) -> [PrintLaTeX Doc] -> PrintLaTeX Doc
tpRunPrint ([Doc] -> Doc
TP.vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
TP.punctuate Doc
x)

-- Combine 'TP.hcat' and 'TP.punctuate'.
hpunctuate :: TP.Doc -> [D] -> D
hpunctuate :: Doc -> [PrintLaTeX Doc] -> PrintLaTeX Doc
hpunctuate Doc
x = ([Doc] -> Doc) -> [PrintLaTeX Doc] -> PrintLaTeX Doc
tpRunPrint ([Doc] -> Doc
TP.hcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
TP.punctuate Doc
x)
--------
-- | MathContext operations.
lub :: MathContext -> MathContext -> MathContext
lub :: MathContext -> MathContext -> MathContext
lub MathContext
Math MathContext
Math = MathContext
Math
lub MathContext
Text MathContext
Text = MathContext
Text
lub MathContext
Curr MathContext
Curr = MathContext
Curr
lub MathContext
Curr MathContext
x    = MathContext
x
lub MathContext
x    MathContext
Curr = MathContext
x
lub MathContext
_    MathContext
_    = MathContext
Text -- Text is top-most

-----------------
-- Hacked up version, will get deleted
-- | Latex type. Holds 'String's.
newtype Latex = L { Latex -> String
unPL :: String }

-- | Renders special characters.
instance RenderSpecial Latex where
  special :: Special -> Latex
special Special
Circle       = String -> Latex
L String
"{}^{\\circ}"
  -- special Partial      = L "\\partial{}"