module Text.LaTeX.Base.Writer
(
LaTeXT
, LaTeXT_
, runLaTeXT
, execLaTeXT
, execLaTeXTWarn
, extractLaTeX
, extractLaTeX_
, textell
, rendertexM
, liftFun
, liftOp
, merror
, lift
) where
import Control.Monad.Trans.Writer
import Control.Monad.Trans.State
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Applicative
import Control.Arrow
import Data.String
import Data.Monoid
import Text.LaTeX.Base.Syntax
import Text.LaTeX.Base.Class
import Text.LaTeX.Base.Render
import Text.LaTeX.Base.Warnings (Warning,checkAll,check)
import Control.Monad (liftM)
newtype LaTeXT m a =
LaTeXT { unwrapLaTeXT :: WriterT LaTeX m a }
deriving (Functor,Applicative,Monad,MonadIO)
instance MonadTrans LaTeXT where
lift = LaTeXT . lift
instance Monad m => LaTeXC (LaTeXT m a) where
liftListL f xs = mapM extractLaTeX_ xs >>= merror "liftListL" . textell . f
type LaTeXT_ m = LaTeXT m ()
runLaTeXT :: LaTeXT m a -> m (a,LaTeX)
runLaTeXT = runWriterT . unwrapLaTeXT
execLaTeXT :: Monad m => LaTeXT m a -> m LaTeX
execLaTeXT = liftM snd . runLaTeXT
execLaTeXTWarn :: Monad m => LaTeXT m a -> m (LaTeX,[Warning])
execLaTeXTWarn = liftM (id &&& check checkAll) . execLaTeXT
extractLaTeX :: Monad m => LaTeXT m a -> LaTeXT m (a,LaTeX)
extractLaTeX = LaTeXT . lift . runLaTeXT
extractLaTeX_ :: Monad m => LaTeXT m a -> LaTeXT m LaTeX
extractLaTeX_ = liftM snd . extractLaTeX
textell :: Monad m => LaTeX -> LaTeXT m ()
textell = LaTeXT . tell
liftFun :: Monad m
=> (LaTeX -> LaTeX)
-> (LaTeXT m a -> LaTeXT m a)
liftFun f ml = do
(a,l') <- lift $ do
(a,l) <- runLaTeXT ml
let l' = f l
return (a,l')
textell l'
return a
liftOp :: Monad m
=> (LaTeX -> LaTeX -> LaTeX)
-> (LaTeXT m a -> LaTeXT m a -> LaTeXT m a)
liftOp op ml1 ml2 = do
(a,l') <- lift $ do
(_,l1) <- runLaTeXT ml1
(a,l2) <- runLaTeXT ml2
let l' = l1 `op` l2
return (a,l')
textell l'
return a
rendertexM :: (Render a, Monad m) => a -> LaTeXT_ m
rendertexM = textell . rendertex
merror :: Monad m => String -> LaTeXT m a -> LaTeXT m b
merror = flip (>>) . return . error
instance Monad m => IsString (LaTeXT m a) where
fromString = (>> return undefined) . textell . fromString
instance Monad m => Monoid (LaTeXT m a) where
mempty = return undefined
mappend = (>>)