module Text.LaTeX.Base.Writer
(
LaTeXT
, LaTeXT_
, runLaTeXT
, execLaTeXT
, execLaTeXTWarn
, extractLaTeX
, extractLaTeX_
, textell
, rendertexM
, liftFun
, liftOp
, throwError
, merror
, lift
, liftIO
) 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,Maybe String) }
instance Functor m => Functor (LaTeXT m) where
fmap f (LaTeXT c) = LaTeXT $ fmap (first f) c
type LaTeXT_ m = LaTeXT m ()
pairNoth :: a -> (a,Maybe b)
pairNoth x = (x,Nothing)
instance MonadTrans LaTeXT where
lift = LaTeXT . liftM pairNoth . lift
instance Monad m => Monad (LaTeXT m) where
return = lift . return
(LaTeXT c) >>= f = LaTeXT $ do
(a,_) <- c
let LaTeXT c' = f a
c'
instance MonadIO m => MonadIO (LaTeXT m) where
liftIO = lift . liftIO
instance Monad m => LaTeXC (LaTeXT m a) where
liftListL f xs = mapM extractLaTeX_ xs >>= merror "liftListL" . textell . f
runLaTeXT :: Monad m => LaTeXT m a -> m (Either String a,LaTeX)
runLaTeXT (LaTeXT c) = runWriterT c >>= (
\((a,m),l) -> case m of
Nothing -> return (Right a ,l)
Just err -> return (Left err,l)
)
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 c) = LaTeXT $ do
((a,m),l) <- lift $ runWriterT c
return ((a,l),m)
extractLaTeX_ :: Monad m => LaTeXT m a -> LaTeXT m LaTeX
extractLaTeX_ = liftM snd . extractLaTeX
textell :: Monad m => LaTeX -> LaTeXT m ()
textell = LaTeXT . liftM pairNoth . tell
liftFun :: Monad m
=> (LaTeX -> LaTeX)
-> (LaTeXT m a -> LaTeXT m a)
liftFun f (LaTeXT c) = LaTeXT $ do
(p,l) <- lift $ runWriterT c
tell $ f l
return p
liftOp :: Monad m
=> (LaTeX -> LaTeX -> LaTeX)
-> (LaTeXT m a -> LaTeXT m b -> LaTeXT m b)
liftOp op (LaTeXT c) (LaTeXT c') = LaTeXT $ do
(_,l) <- lift $ runWriterT c
(p,l') <- lift $ runWriterT c'
tell $ l `op` l'
return p
rendertexM :: (Render a, Monad m) => a -> LaTeXT m ()
rendertexM = textell . rendertex
throwError :: Monad m => String -> LaTeXT m a
throwError = LaTeXT . return . (error &&& Just)
merror :: Monad m => String -> LaTeXT m a -> LaTeXT m b
merror = flip (>>) . throwError
instance Monad m => IsString (LaTeXT m a) where
fromString = merror "LaTeXT: fromString!" . textell . fromString
instance Monad m => Monoid (LaTeXT m a) where
mempty = return undefined
mappend = (>>)