-- | Some 'IO' computations on 'LaTeX' monad.
module Text.LaTeX.IO where

import System.IO

import Text.LaTeX.Monad
import Text.LaTeX.Result

readFileLx :: FilePath -> LaTeXM LaTeX
readFileLx = (>>= return . lx . toResult) . iolx . readFile

writeFileLx :: FilePath -> LaTeXM a -> LaTeX
writeFileLx fp l = iolx $ do x <- nlx l
                             writeFile fp $ fromResult x

appendFileLx :: FilePath -> LaTeXM a -> LaTeX
appendFileLx fp l = iolx $ do x <- nlx l
                              appendFile fp $ fromResult x

hGetLineLx :: Handle -> LaTeXM LaTeX
hGetLineLx = (>>= return . lx . toResult) . iolx . hGetLine

hGetContentsLx :: Handle -> LaTeXM LaTeX
hGetContentsLx = (>>= return . lx . toResult) . iolx . hGetContents

hPutStrLx :: Handle -> LaTeXM a -> LaTeX
hPutStrLx h l = iolx $ do x <- nlx l
                          hPutStr h $ fromResult x

hPutStrLnLx :: Handle -> LaTeXM a -> LaTeX
hPutStrLnLx h l = iolx $ do x <- nlx l
                            hPutStrLn h $ fromResult x

putStrLx :: LaTeXM a -> LaTeX
putStrLx x = iolx $ nlx x >>= putStr . fromResult

putStrLnLx :: LaTeXM a -> LaTeX
putStrLnLx x = iolx $ nlx x >>= putStrLn . fromResult

getLineLx :: LaTeXM LaTeX
getLineLx = (>>= return . lx . toResult) $ iolx $ getLine

getContentsLx :: LaTeXM LaTeX
getContentsLx = (>>= return . lx . toResult) $ iolx $ getContents