module Text.LaTeX.Monad (
    -- * @LaTeX@ Monad
    LaTeXM
  , LaTeX
    -- * Basic functions over @LaTeX@ Monad
  , lx
  , lxany
  , lxw
  , lxanyw
  , nlx
  , iolx
  , reslx
    -- * Generalizing
  , genlx , ungenlx
  ) where

import Control.Monad.Writer
import Data.Monoid
import GHC.Exts
import System.IO.Unsafe
import Text.LaTeX.Result

----------------------------

type LaTeXM a = WriterT Result IO a

type LaTeX = LaTeXM ()

----------------------------
-- Running the Monad

nlx :: LaTeXM a -> IO Result
nlx = execWriterT

----------------------------

lx :: Result -> LaTeX
lx = tell

lxany :: Show a => a -> LaTeX
lxany = lx . toResult . show

lxw :: Result -> LaTeXM a
lxw x = do lx x
           return undefined

lxanyw :: Show b => b -> LaTeXM a
lxanyw = lxw . toResult . show

iolx :: IO a -> LaTeXM a
iolx = liftIO

reslx :: (Result -> Result) -> (LaTeXM a -> LaTeXM a)
reslx = censor

instance IsString (LaTeXM a) where
 fromString = lxw . toResult

instance Show (LaTeXM a) where
 show = fromResult . unsafePerformIO . nlx

instance Eq (LaTeXM a) where
 x == y = show x == show y

--

genlx :: LaTeX -> LaTeXM a
genlx = (>> return undefined)

ungenlx :: LaTeXM a -> LaTeX
ungenlx = (>> return ())