{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
module System.Texrunner.Online
( OnlineTex
, runOnlineTex
, runOnlineTex'
, hbox
, hsize
, showthe
, onlineTexParser
, texPutStrLn
, TexStreams
, getInStream
, getOutStream
, clearUnblocking
) where
import Control.Applicative
import Control.Monad.Reader
import qualified Data.Attoparsec.ByteString as A
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as C8
import qualified Data.ByteString.Lazy.Char8 as LC8
import Data.List (find)
import Data.Maybe
import Data.Monoid
import qualified Data.Traversable as T
import System.Directory
import System.FilePath
import System.IO
import System.IO.Streams as Streams
import System.IO.Streams.Attoparsec
import System.IO.Temp
import System.Process as P (runInteractiveProcess)
import System.Texrunner.Parse
newtype OnlineTex a = OnlineTex {runOnlineTexT :: ReaderT TexStreams IO a}
deriving (Functor, Applicative, Monad, MonadIO, MonadReader TexStreams)
runOnlineTex :: String
-> [String]
-> ByteString
-> OnlineTex a
-> IO a
runOnlineTex command args preamble process =
(\(a,_,_) -> a) <$> runOnlineTex' command args preamble process
runOnlineTex' :: String
-> [String]
-> ByteString
-> OnlineTex a
-> IO (a, TexLog, Maybe LC8.ByteString)
runOnlineTex' command args preamble process =
withSystemTempDirectory "onlinetex." $ \path -> do
(outS, inS, h) <- mkTexHandles path Nothing command args preamble
a <- flip runReaderT (outS, inS) . runOnlineTexT $ process
write Nothing outS
_ <- waitForProcess h
pdfPath <- find ((==".pdf") . takeExtension) <$> getDirectoryContents path
pdfFile <- T.mapM (LC8.readFile . (path </>)) pdfPath
logPath <- find ((==".log") . takeExtension) <$> getDirectoryContents path
logFile <- T.mapM (C8.readFile . (path </>)) logPath
return (a, parseLog $ fromMaybe "" logFile, pdfFile)
hbox :: Fractional n => ByteString -> OnlineTex (Box n)
hbox str = do
clearUnblocking
texPutStrLn $ "\\setbox0=\\hbox{" <> str <> "}\n\\showbox0\n"
onlineTexParser parseBox
showthe :: Fractional n => ByteString -> OnlineTex n
showthe str = do
clearUnblocking
texPutStrLn $ "\\showthe" <> str
onlineTexParser parseUnit
hsize :: Fractional n => OnlineTex n
hsize = boxWidth <$> hbox "\\line{\\hfill}"
onlineTexParser :: A.Parser a -> OnlineTex a
onlineTexParser p = getInStream >>= liftIO . parseFromStream p
texPutStrLn :: ByteString -> OnlineTex ()
texPutStrLn a = getOutStream >>= liftIO . write (Just $ C8.append a "\n")
type TexStreams = (OutputStream ByteString, InputStream ByteString)
getOutStream :: OnlineTex (OutputStream ByteString)
getOutStream = reader fst
getInStream :: OnlineTex (InputStream ByteString)
getInStream = reader snd
clearUnblocking :: OnlineTex ()
clearUnblocking = getInStream >>= void . liftIO . Streams.read
mkTexHandles :: FilePath
-> Maybe [(String, String)]
-> String
-> [String]
-> ByteString
-> IO (OutputStream ByteString,
InputStream ByteString,
ProcessHandle)
mkTexHandles dir env command args preamble = do
(outStream, inStream, _, h) <- runInteractiveProcess'
command
args
(Just dir)
env
write (Just $ "\\tracingonline=1"
<> "\\showboxdepth=1"
<> "\\showboxbreadth=1"
<> "\\scrollmode\n"
) outStream
write (Just preamble) outStream
return (outStream, inStream, h)
runInteractiveProcess'
:: FilePath
-> [String]
-> Maybe FilePath
-> Maybe [(String,String)]
-> IO (OutputStream ByteString,
InputStream ByteString,
InputStream ByteString,
ProcessHandle)
runInteractiveProcess' cmd args wd env = do
(hin, hout, herr, ph) <- P.runInteractiveProcess cmd args wd env
hSetBuffering hin LineBuffering
sIn <- Streams.handleToOutputStream hin >>=
Streams.atEndOfOutput (hClose hin) >>=
Streams.lockingOutputStream
sOut <- Streams.handleToInputStream hout >>=
Streams.atEndOfInput (hClose hout) >>=
Streams.lockingInputStream
sErr <- Streams.handleToInputStream herr >>=
Streams.atEndOfInput (hClose herr) >>=
Streams.lockingInputStream
return (sIn, sOut, sErr, ph)